{
  This file is a part of the Open Source Synopse mORMot framework 2,
  licensed under a MPL/GPL/LGPL three license - see LICENSE.md

   POSIX API calls for FPC, as used by mormot.core.os.pas
}

{$ifdef FPC}

uses
  baseunix,
  unix,
  unixcp,
  unixtype,
  unixutil, // for TZSeconds - as used by sysutils anyway
  {$ifdef OSBSDDARWIN}
  sysctl,
  {$else}
  linux,
  syscall,
  {$endif OSBSDDARWIN}
  {$ifdef FPCUSEVERSIONINFO} // to be enabled in mormot.defines.inc
    fileinfo,        // FPC 3.0 and up
    {$ifdef OSDARWIN}
      machoreader,   // MACH-O executables
    {$else}
      elfreader,     // ELF executables
    {$endif OSDARWIN}
  {$endif FPCUSEVERSIONINFO}
  errors,
  termio,
  dl,
  initc; // we statically link the libc for some raw calls

{$ifdef UNICODE}
  'mORMot assumes no UNICODE on POSIX FPC, i.e. as TFileName = PChar = PUtf8Char'
{$endif UNICODE}

{$else}

// rough preparation for Delphi compatibility - not finished at all
uses
  System.IOUtils,
  System.SyncObjs;

{$endif FPC}

// define some raw text functions, to avoid linking mormot.core.text

function _fmt(const Fmt: string; const Args: array of const): RawUtf8;
  overload; forward;
procedure _fmt(const Fmt: string; const Args: array of const;
  var result: RawUtf8); overload; forward;
procedure _AddRawUtf8(var Values: TRawUtf8DynArray; const Value: RawUtf8); forward;
function _GetNextSpaced(var P: PAnsiChar): RawUtf8; forward;
function _GetNextCardinal(var P: PAnsiChar): PtrUInt; forward;
function PosExtString(Str: PChar): PChar; forward; // to extract extension

procedure WrDeb(const t: ShortString; const p; l: PtrInt); // internal use below
var
  tmp: RawUtf8;
begin
  ToHumanHex(tmp, @p, l);
  {$I-}writeln(t, ' = ',tmp);{$I+}
end;

function IdemPChar(p, up: PUtf8Char): boolean; inline;
var
  c, u: AnsiChar;
begin
  // we know that p<>nil and up<>nil within this unit
  result := false;
  repeat
    u := up^;
    if u = #0 then
      break;
    c := p^;
    if (c >= 'a') and
       (c <= 'z') then
      dec(c, 32);
    if c <> u then
      exit;
    inc(up);
    inc(p);
  until false;
  result := true;
end;

function IdemPChars(const s: RawUtf8; const up: array of PUtf8Char): boolean;
var
  i: PtrInt;
begin
  result := true;
  if s <> '' then
    for i := 0 to high(up) do
      if IdemPChar(pointer(s), up[i]) then
        exit;
  result := false;
end;


{ ****************** Unicode, Time, File process }

var // two flag sets of 8 items = 8-bit byte efficient storage and access
  _F0: set of (fIsDebuggerTested, fIsDebuggerPresent, fStdOutIsTTY,
    fNoURandom, fNoRandom, fProcFileSystemsTested,
    fLinuxEventFdFailed, fLinuxGetRandomFailed);
  _F1: set of (fMachTimeNanoSec, fNoTryProcExe, fStubMemoryExecXorWrite,
    fSynDaemonIntercepted, fSigPipeDisabled);

function SortDynArrayFileName(const A, B): integer;
begin // file extension, then file name case-sensitive comparison on POSIX
  result := 0;
  if pointer(A) = pointer(B) then
    exit;
  result := {$ifdef UNICODE}StrCompW{$else}StrComp{$endif}(
              PosExtString(pointer(A)), PosExtString(pointer(B)));
  if result = 0 then
    result := {$ifdef UNICODE}StrCompW{$else}StrComp{$endif}(pointer(A), pointer(B));
end;

function TDirectoryBrowser.Make(const fn: TFileName): TFileName;
begin
  result := fCurrentDir + fn; // MAX_PATH is usually not a concern on POSIX
end;

function LibraryOpen(const LibraryName: TFileName): TLibHandle;
begin
  result := TLibHandle(dlopen(pointer(LibraryName), RTLD_LAZY));
end;

procedure LibraryClose(Lib: TLibHandle);
begin
  dlclose(pointer(Lib));
end;

function LibraryResolve(Lib: TLibHandle; ProcName: PAnsiChar): pointer;
begin
  result := dlsym(pointer(Lib), ProcName);
end;

function LibraryError: string;
begin
  result := dlerror;
end;


{ TIcuLibrary }

procedure TIcuLibrary.Done;
var
  i: PtrInt;
begin
  if fLoaded then
  begin
    for i := 0 to fSharedCount - 1 do
      ucnv_close(fSharedCnv[i]);
    fSharedCount := 0;
  end;
  if icui18n <> nil then
    dlclose(icui18n);
  if icu <> nil then
    dlclose(icu);
  if icudata <> nil then
    dlclose(icudata);
  icu := nil;
  icudata := nil;
  icui18n := nil;
  @ucnv_open := nil;
end;

function TIcuLibrary.IsAvailable: boolean;
begin
  if not fLoaded then
    DoLoad;
  result := Assigned(ucnv_open);
end;

function IsWideStringManagerProperlyInstalled: boolean;
const
  u: WideChar = #$2020; // should convert to dagger glyph #134 in CP 1252
var
  d: RawByteString;
begin
  try
    widestringmanager.Unicode2AnsiMoveProc(@u, d, 1252, 1);
    result := (length(d) = 1) and
              (d[1] = #134);
    // the default RTL handler would just return '?'
  except
    result := false;
  end;
end;

procedure TIcuLibrary.DoLoad(const LibName: TFileName; Version: string);
const
  NAMES: array[0..13] of string = (
    'ucnv_open',
    'ucnv_close',
    'ucnv_reset',
    'ucnv_setSubstChars',
    'ucnv_setFallback',
    'ucnv_fromUChars',
    'ucnv_toUChars',
    'u_strToUpper',
    'u_strToLower',
    'u_strCompare',
    'u_strCaseCompare',
    'u_getDataDirectory',
    'u_setDataDirectory',
    'u_init');
  {$ifdef OSANDROID}
  // https://developer.android.com/guide/topics/resources/internationalization
  ICU_VER: array[1..15] of string = (
    '_3_8', '_4_2', '_44', '_46', '_48', '_50', '_51', '_53', '_55',
    '_56', '_58', '_60', '_63', '_66', '_68');
  ICU_MAX = 80;
  ICU_MIN = 69; // previous versions are known and listed within ICU_VER[]
  SYSDATA: PAnsiChar = '/system/usr/icu';
  {$else}
  ICU_MAX = 80;
  ICU_MIN = 44;
  SYSDATA: PAnsiChar = '';
  {$endif OSANDROID}
var
  i: integer;
  err: SizeInt;
  P: PPointer;
  {$ifndef OSDARWIN}
  so: string;
  {$endif OSDARWIN}
  v, vers: string;
  data: PAnsiChar;
begin
  GlobalLock;
  try
    if fLoaded then
      exit;
    fLoaded := true;
    fSharedCount := 0;
    if LibName <> '' then
    begin
      icu := dlopen(pointer(LibName), RTLD_LAZY);
      if icu = nil then
        exit;
    end
    else
    begin
      {$ifdef OSDARWIN}
      // Mach OS has its own ICU set of libraries
      icu := dlopen('libicuuc.dylib', RTLD_LAZY);
      if icu <> nil then
        icui18n := dlopen('libicui18n.dylib', RTLD_LAZY);
      {$else}
      // libicudata should be loaded first because other two depend on it
      icudata := dlopen('libicudata.so', RTLD_LAZY);
      {$ifndef OSANDROID}
      if icudata = nil then
      begin
        // there is no link to the library -> try e.g. 'libicudata.so.67'
        if Version <> '' then
          icudata := dlopen(pointer('libicudata.so.' + Version), RTLD_LAZY);
        if icudata = nil then
          for i := ICU_MAX downto ICU_MIN do
          begin
            str(i, v);
            icudata := dlopen(pointer('libicudata.so.' + v), RTLD_LAZY);
            if icudata <> nil then
            begin
              Version := v;
              break;
            end;
          end;
        if icudata <> nil then
          so := '.' + Version;
      end;
      {$endif OSANDROID}
      if icudata <> nil then
      begin
        icu := dlopen(pointer('libicuuc.so' + so), RTLD_LAZY);
        if icu <> nil then
          icui18n := dlopen(pointer('libicui18n.so' + so), RTLD_LAZY);
      end;
      {$endif OSDARWIN}
      if icui18n = nil then
      begin
        // we did not find any ICU installed -> ensure iconv/RTL fallback is ok
        if not IsWideStringManagerProperlyInstalled then
          DisplayFatalError('ICU ' + CPU_ARCH_TEXT + ' is not available',
            'Either install it or put cwstring in your uses clause as fallback');
        Done;
        exit;
      end
    end;
    // ICU append a version prefix to all its functions e.g. ucnv_open_66
    if (Version <> '') and
       (dlsym(icu, pointer('ucnv_open_' + Version)) <> nil) then
      vers := '_' + Version // matched the explicit version
    else
    begin
      {$ifdef OSANDROID}
      for i := high(ICU_VER) downto 1 do
      begin
        if dlsym(icu, pointer(NAMES[0] + ICU_VER[i])) <> nil then
        begin
          vers := ICU_VER[i];
          break;
        end;
      end;
      if vers <> '' then
      {$endif OSANDROID}
      if dlsym(icu, 'ucnv_open') = nil then
        for i := ICU_MAX downto ICU_MIN do
        begin
          str(i, v);
          if dlsym(icu, pointer('ucnv_open_' + v)) <> nil then
          begin
            vers := '_' + v;
            break;
          end;
        end;
    end;
    P := @@ucnv_open;
    for i := 0 to high(NAMES) do
    begin
      P[i] := dlsym(icu, pointer(NAMES[i] + vers));
      if P[i] = nil then
      begin
        @ucnv_open := nil;
        exit;
      end;
    end;
    data := u_getDataDirectory;
    if (data = nil) or
       (data^ = #0) then
      if SYSDATA <> '' then
        u_setDataDirectory(SYSDATA);
    err := 0;
    u_init(err);
  finally
    GlobalUnLock;
  end;
end;

function TIcuLibrary.ForceLoad(const LibName: TFileName; const Version: string): boolean;
begin
  Done;
  fLoaded := false;
  DoLoad(LibName, Version);
  result := Assigned(ucnv_open);
end;

function TIcuLibrary.ucnv(codepage: cardinal): pointer;
var
  cp: ShortString;
  err: SizeInt;
  {$ifdef CPUINTEL}
  mask: cardinal;
  {$endif CPUINTEL}
begin
  if not IsAvailable then
    exit(nil);
  Unicode_CodePageName(codepage, cp);
  {$ifdef CPUINTEL}
  mask := GetMXCSR;
  SetMXCSR(mask or $0080 {MM_MaskInvalidOp} or $1000 {MM_MaskPrecision});
  {$endif CPUINTEL}
  err := 0;
  result := ucnv_open(@cp[1], err);
  if result <> nil then
  begin
    err := 0;
    ucnv_setSubstChars(result, '?', 1, err);
    ucnv_setFallback(result, true);
  end;
  {$ifdef CPUINTEL}
  SetMXCSR(mask);
  {$endif CPUINTEL}
end;

function TIcuLibrary.SharedUcnv(codepage: cardinal; out ndx: PtrInt): pointer;
var
  i, n: PtrInt;
begin
  result := nil;
  if (codepage < CP_MIN) or
     (codepage >= CP_RAWBLOB) or
     not IsAvailable then
    exit;
  // quickly check if this codepage is part of cached converters
  n := fSharedCount;
  i := fSharedLast;
  if (PtrUInt(i) >= PtrUInt(n)) or
     (fSharedCP[i] <> codepage) then
    i := WordScanIndex(@fSharedCP, n, codepage); // SSE2 brute force search
  if i >= 0 then
  begin
    ndx := i; // for eventual SharedUcnvUnLock()
    fSharedLast := i; // optimistic usage
    if PLightLock(@fSharedLock[i])^.TryLock then
      result := fSharedCnv[i]; // this thread acquired this converter
    exit;
  end;
  // first time we see this codepage: try to add in our internal cache
  PLightLock(@fSharedMainLock)^.Lock; // main write lock
  try
    n := fSharedCount;
    if (n <> length(fSharedCP)) and // cache up to 32 instances
       (WordScanIndex(@fSharedCP, n, codepage) < 0) then // paranoid
    begin
      result := ucnv(codepage);
      if result = nil then
        exit;
      ndx := n;
      fSharedLast := n;
      fSharedCP[n] := CodePage;
      fSharedLock[n] := 1; // = Init + Lock
      fSharedCnv[n] := result;
      inc(fSharedCount); // should be set last
    end;
  finally
    PLightLock(@fSharedMainLock)^.UnLock;
  end;
end;

procedure TIcuLibrary.SharedUcnvUnLock(ndx: PtrInt);
begin
  ucnv_reset(fSharedCnv[ndx]); // clean-up from this thread (before unlock)
  PLightLock(@fSharedLock[ndx])^.UnLock;
end;

const
  // for CompareStringW() Windows-like call in Unicode_CompareString()
  LOCALE_USER_DEFAULT = $400; // ignored in practice
  NORM_IGNORECASE = 1 shl ord(coIgnoreCase); // [widestringmanager.coIgnoreCase]
  U_FOLD_CASE_DEFAULT = 0;
  U_COMPARE_CODE_POINT_ORDER = $8000;

function CompareStringRTL(A, B: PWideChar; AL, BL, flags: integer): integer;
var
  U1, U2: UnicodeString; // allocate two temporary strings :(
begin
  // cwstring as fallback, using iconv on systems where ICU is not available
  FastSynUnicode(U1, A, AL);
  FastSynUnicode(U2, B, BL);
  result := widestringmanager.CompareUnicodeStringProc(
    U1, U2, TCompareOptions(flags));
end;

function CompareStringW(locale, flags: DWORD;
  A: PWideChar; AL: integer; B: PWideChar; BL: integer): PtrInt;
var
  err: SizeInt;
begin
  if AL < 0 then
    AL := StrLenW(A);
  if BL < 0 then
    BL := StrLenW(B);
  err := 0;
  if icu.IsAvailable then // use the standard ICU library available on this system
    if flags and NORM_IGNORECASE <> 0 then
      result := icu.u_strCaseCompare(A, AL, B, BL, U_COMPARE_CODE_POINT_ORDER, err)
    else
      result := icu.u_strCompare(A, AL, B, BL, {codepointorder=}true)
  else
    result := CompareStringRTL(A, B, AL, BL, flags); // RTL fallback
  inc(result, 2); // caller would make -2 to get regular -1/0/1 comparison values
end;

function AnsiToWideRTL(CodePage: cardinal; A: PAnsiChar; W: PWideChar;
  AL, WL: PtrInt): PtrInt;
var
  tmp: UnicodeString;
begin
  // cwstring as fallback, using iconv on systems where ICU is not available
  widestringmanager.Ansi2UnicodeMoveProc(A, CodePage, tmp, AL);
  result := length(tmp);
  if result > WL then
    result := WL;
  MoveFast(pointer(tmp)^, W^, result * 2);
end;

function Unicode_AnsiToWide(A: PAnsiChar; W: PWideChar;
  LA, LW, CodePage: PtrInt): integer;
var
  cnv: pointer;
  err: SizeInt;
  ndx: PtrInt;
begin
  if CodePage = CP_UTF8 then
  begin
    result := Utf8ToUnicode(W, LW, A, LA); // FPC RTL is safe and fast enough
    if result > 0 then
      dec(result); // Utf8ToUnicode() returned length includes #0 terminator
    exit;
  end
  else if (CodePage < CP_MIN) or
          (LA <= 0) then
    exit(0); // clearly invalid/unsupported CodePage or void input
  err := 0;
  cnv := icu.SharedUcnv(CodePage, ndx); // try from our thread-safe cache
  if cnv <> nil then
  begin
    result := icu.ucnv_toUChars(cnv, W, LW, A, LA, err);
    icu.SharedUcnvUnLock(ndx);
  end
  else
  begin
    cnv := icu.ucnv(CodePage); // use a transient converter if locked
    if cnv <> nil then
    begin
      result := icu.ucnv_toUChars(cnv, W, LW, A, LA, err);
      icu.ucnv_close(cnv);
    end
    else // fallback to cwstring/iconv
      result := AnsiToWideRTL(CodePage, A, W, LA, LW);
  end;
  if result < 0 then
    result := 0;
end;

function WideToAnsiRTL(CodePage: cardinal; W: PWideChar; A: PAnsiChar;
  WL, AL: PtrInt): PtrInt;
var
  tmp: RawByteString;
begin
  // cwstring as fallback, using iconv on systems where ICU is not available
  widestringmanager.Unicode2AnsiMoveProc(W, tmp, CodePage, WL);
  result := length(tmp);
  if result > AL then
    result := AL;
  MoveFast(pointer(tmp)^, A^, result);
end;

function Unicode_WideToAnsi(W: PWideChar; A: PAnsiChar;
  LW, LA, CodePage: PtrInt): integer;
var
  cnv: pointer;
  err: SizeInt;
  ndx: PtrInt;
begin
  if CodePage = CP_UTF8 then // FPC RTL is correct, and fast enough for UTF-8
  begin
    result := UnicodeToUtf8(A, LA, W, LW);
    if result > 0 then
      dec(result); // UnicodeToUtf8() result includes the #0 terminator
    exit;
  end
  else if (CodePage < CP_MIN) or
          (LW <= 0) then
    exit(0); // clearly invalid/unsupported CodePage or void input
  err := 0;
  cnv := icu.SharedUcnv(CodePage, ndx); // try from our thread-safe cache
  if cnv <> nil then
  begin
    result := icu.ucnv_fromUChars(cnv, A, LA, W, LW, err);
    icu.SharedUcnvUnLock(ndx);
  end
  else
  begin
    cnv := icu.ucnv(CodePage); // use a transient converter if locked
    if cnv <> nil then
    begin
      result := icu.ucnv_fromUChars(cnv, A, LA, W, LW, err);
      icu.ucnv_close(cnv);
    end
    else // fallback to cwstring/iconv (less complete than ICU)
      result := WideToAnsiRTL(CodePage, W, A, LW, LA);
  end;
  if result <= 0 then
    result := 0
  else
    case CodePage of
      CP_HZ: // HZ-GB2312
        if PWord(A)^ = ord('~') + ord('}') shl 8 then // to match Windows API
        begin
          dec(result, 2); // trim RFC 1842 escape from HZ mode to ASCII mode
          MoveFast(A[2], A[0], result);
        end;
    end;
end;

function Unicode_InPlaceUpper(W: PWideChar; WLen: integer): integer;
var
  err, i: SizeInt;
begin
  if icu.IsAvailable then
  begin
    // call the more accurate ICU library
    err := 0;
    result := icu.u_strToUpper(W, WLen, W, WLen, nil, err);
  end
  else
  begin
    // simple fallback code only handling 'a'..'z' -> 'A'..'Z' basic conversion
    for i := 0 to WLen - 1 do
      if ord(W[i]) in [ord('a')..ord('z')] then
        dec(W[i], 32);
    result := WLen;
  end;
end;

function Unicode_InPlaceLower(W: PWideChar; WLen: integer): integer;
var
  err, i: SizeInt;
begin
  if icu.IsAvailable then
  begin
    // call the accurate ICU library
    err := 0;
    result := icu.u_strToLower(W, WLen, W, WLen, nil, err);
  end
  else
  begin
    // simple fallback code only handling 'A'..'Z' -> 'a'..'z' basic conversion
    for i := 0 to WLen - 1 do
      if ord(W[i]) in [ord('A')..ord('Z')] then
        inc(W[i], 32);
    result := WLen;
  end;
end;

function GetDesktopWindow: PtrUInt;
begin
  result := 0; // fixed result on a window-abstracted system
end;


{$ifdef NODIRECTTHREADMANAGER} // try to stabilize MacOS/BSD pthreads API calls

function GetCurrentThreadId: TThreadID;
begin
  result := system.GetCurrentThreadID();
end;

function TryEnterCriticalSection(var cs: TRTLCriticalSection): integer;
begin
  result := system.TryEnterCriticalSection(cs);
end;

procedure EnterCriticalSection(var cs: TRTLCriticalSection);
begin
  system.EnterCriticalSection(cs);
end;

procedure LeaveCriticalSection(var cs: TRTLCriticalSection);
begin
  system.LeaveCriticalSection(cs);
end;

{$endif NODIRECTTHREADMANAGER}

const
  // Date Translation - see http://en.wikipedia.org/wiki/Julian_day
  D0 = 1461;
  D1 = 146097;
  D2 = 1721119;
  C1970 = 2440588;

procedure JulianToGregorian(JulianDN: PtrUInt; out result: TSystemTime);
  {$ifdef HASINLINE}inline;{$endif}
var
  YYear, XYear, Temp, TempMonth: PtrUInt;
begin
  Temp := ((JulianDN - D2) * 4) - 1;
  JulianDN := Temp div D1;
  XYear := (Temp - (JulianDN * D1)) or 3;
  YYear := XYear div D0;
  Temp := (((XYear - (YYear * D0) + 4) shr 2) * 5) - 3;
  TempMonth := Temp div 153;
  result.Day := PtrUInt((Temp - (TempMonth * 153)) + 5) div 5;
  if TempMonth >= 10 then
  begin
    inc(YYear);
    dec(TempMonth, 12 - 3);
  end
  else
    inc(TempMonth, 3);
  result.Month := TempMonth;
  result.Year := YYear + (JulianDN * 100);
  // initialize fake dayOfWeek - as used by FromGlobalTime()
  result.DayOfWeek := 0;
end;

procedure EpochToSystemTime(epoch: PtrUInt; out result: TSystemTime);
var
  t: PtrUInt;
begin
  t := epoch div SecsPerDay;
  JulianToGregorian(t + C1970, result);
  dec(epoch, t * SecsPerDay);
  t := epoch div SecsPerHour;
  result.Hour := t;
  dec(epoch, t * SecsPerHour);
  t := epoch div SecsPerMin;
  result.Minute := t;
  result.Second := epoch - t * SecsPerMin;
end;

{$ifdef OSDARWIN} // OSX has no clock_gettime() API but its own MACH API

type
  TTimebaseInfoData = record
    Numer: cardinal;
    Denom: cardinal;
  end;

function mach_absolute_time: UInt64;
  cdecl external clib name 'mach_absolute_time';

function mach_continuous_time: UInt64;
  cdecl external clib name 'mach_continuous_time';

function mach_timebase_info(var TimebaseInfoData: TTimebaseInfoData): integer;
  cdecl external clib name 'mach_timebase_info';

function host_processor_info(host, flavor: cint; var proccount: cardinal;
  var info: PCardinalArray; var infocount: cardinal): cint;
  cdecl external '_host_processor_info';

function mach_host_self: cint;
  cdecl external '_mach_host_self';

var
  mach_timeinfo: TTimebaseInfoData;
  mach_timecoeff: double;

const
  PROCESSOR_CPU_LOAD_INFO = 2;

procedure machtimetonanosec(var Value: Int64); inline;
begin
  if not (fMachTimeNanoSec in _F1) then // very likely to be set in practice
    if mach_timeinfo.Denom = 1 then
      // integer resolution is enough
      Value := Value * mach_timeinfo.Numer
    else
      // use floating point to avoid potential overflow
      Value := round(Value * mach_timecoeff);
end;

procedure QueryPerformanceMicroSeconds(out Value: Int64);
begin
  Value := mach_absolute_time;
  machtimetonanosec(Value);
  Value := Value div NanoSecsPerMicroSec; // ns to us
end;

function GetTickCount64: Int64;
begin
  result := mach_absolute_time;
  machtimetonanosec(result);
  result := result div NanoSecsPerMilliSec; // ns to ms
end;

function GetTickSec: cardinal;
var
  v: Int64;
begin
  v := mach_absolute_time;
  machtimetonanosec(v);
  result := v div NanoSecsPerSec; // ns to s
end;

function GetUptimeSec: cardinal;
var
  v: Int64;
begin
  v := mach_continuous_time;
  machtimetonanosec(v);
  result := v div NanoSecsPerSec; // ns to s
end;

function UnixTimeUtc: TUnixTime;
var
  tz: timeval;
begin
  fpgettimeofday(@tz, nil); // from libc
  result := tz.tv_sec;
end;

function UnixMSTimeUtc: TUnixMSTime;
var
  tz: timeval;
begin
  fpgettimeofday(@tz, nil);
  result := (Int64(tz.tv_sec) * MilliSecsPerSec) +
            tz.tv_usec div MicroSecsPerMilliSec; // in milliseconds
end;

procedure GetSystemTime(out result: TSystemTime);
var
  tz: timeval;
begin
  fpgettimeofday(@tz, nil);
  EpochToSystemTime(tz.tv_sec, result);
  result.MilliSecond := tz.tv_usec div MicroSecsPerMilliSec;
end;

procedure GetLocalTime(out result: TSystemTime);
var
  tz: timeval;
begin
  fpgettimeofday(@tz, nil);
  // + unixutil.TZSeconds = UTC to local time conversion
  EpochToSystemTime(tz.tv_sec + TZSeconds, result);
  result.MilliSecond := tz.tv_usec div MicroSecsPerMilliSec;
end;

{$else}


{$ifdef OSBSD}

const
  {$ifdef OSFREEBSD}
  // see https://github.com/freebsd/freebsd/blob/master/sys/sys/time.h
  CLOCK_REALTIME  = 0;
  CLOCK_MONOTONIC = 4;
  CLOCK_BOOTTIME  = 5;
  CLOCK_REALTIME_COARSE  = 10; // named CLOCK_REALTIME_FAST in FreeBSD 8.1+
  CLOCK_MONOTONIC_COARSE = 12;
  {$else}
  // see https://github.com/openbsd/src/blob/master/sys/sys/_time.h#L63
  CLOCK_REALTIME  = 0;
  CLOCK_MONOTONIC = 3;
  CLOCK_BOOTTIME  = 6;
  CLOCK_REALTIME_COARSE  = CLOCK_REALTIME; // no FAST/COARSE version
  CLOCK_MONOTONIC_COARSE = CLOCK_MONOTONIC;
  {$endif OSFREEBSD}

// most BSD systems have VDSO-like implementation via co-evolution of the kernel
// and C runtime - https://www.freebsd.org/status/report-2021-10-2021-12/vdso/

function clock_gettime(clk_id: cardinal; tp: ptimespec): integer;
  cdecl external clib name 'clock_gettime';

function clock_getres(clk_id: cardinal; tp: ptimespec): integer;
  cdecl external clib name 'clock_getres';

{$else}

const
  CLOCK_REALTIME         = 0;
  CLOCK_MONOTONIC        = 1;
  CLOCK_REALTIME_COARSE  = 5; // see http://lwn.net/Articles/347811
  CLOCK_MONOTONIC_COARSE = 6;
  CLOCK_BOOTTIME         = 7; // includes asleep time (2.6.39+)

// libc's clock_gettime function uses vDSO (avoid syscall) while FPC by default
// is compiled without FPC_USE_LIBC defined and do a syscall each time
//   GetTickCount64 fpc    2 494 563 op/sec
//   GetTickCount64 libc 119 919 893 op/sec
function clock_gettime(clk_id: clockid_t; tp: ptimespec): cint;
  cdecl external clib name 'clock_gettime'; // LIBC_SUFFIX fails on CentOS 7

function gettimeofday(tp: ptimeval; tzp: ptimezone): cint;
  cdecl external clib name 'gettimeofday' + LIBC_SUFFIX;

{$endif OSBSD}

var
  // contains CLOCK_REALTIME_COARSE since kernel 2.6.32
  CLOCK_REALTIME_FAST: integer = CLOCK_REALTIME;

  // contains CLOCK_MONOTONIC_COARSE since kernel 2.6.32
  CLOCK_MONOTONIC_FAST: integer = CLOCK_MONOTONIC;

  // contains CLOCK_MONOTONIC_RAW since kernel 2.6.28
  // - so that QueryPerformanceMicroSeconds() is not subject to NTP adjustments
  CLOCK_MONOTONIC_HIRES: integer = CLOCK_MONOTONIC;

  // contains CLOCK_BOOTTIME since kernel 2.6.39
  CLOCK_UPTIME: integer = CLOCK_MONOTONIC;

function UnixMSTimeUtc: TUnixMSTime;
var
  r: timespec;
begin
  clock_gettime(CLOCK_REALTIME_FAST, @r); // likely = CLOCK_REALTIME_COARSE
  // convert from nanoseconds into milliseconds
  result := QWord(PtrUInt(r.tv_nsec) div PtrUInt(NanoSecsPerMilliSec)) +
            QWord(r.tv_sec) * MilliSecsPerSec;
end;

function UnixTimeUtc: TUnixTime;
var
  r: timespec;
begin
  clock_gettime(CLOCK_REALTIME_FAST, @r);
  result := r.tv_sec;
end;

procedure QueryPerformanceMicroSeconds(out Value: Int64);
var
  r : TTimeSpec;
begin
  clock_gettime(CLOCK_MONOTONIC_HIRES, @r);
  // convert from nanoseconds into microseconds
  Value := QWord(PtrUInt(r.tv_nsec) div PtrUInt(NanoSecsPerMicroSec)) +
           QWord(r.tv_sec) * MicroSecsPerSec;
end;

procedure GetSystemTime(out result: TSystemTime);
var
  r: timespec;
begin
  // faster than fpgettimeofday() which makes a syscall and don't use vDSO
  clock_gettime(CLOCK_REALTIME_FAST, @r);
  EpochToSystemTime(r.tv_sec, result);
  result.MilliSecond := PtrUInt(r.tv_nsec) div PtrUInt(NanoSecsPerMilliSec);
end;

// c_timezone: longint external 'c' name 'timezone'; is broken and returns 0

procedure GetLocalTime(out result: TSystemTime);
var
  r: timespec;
begin
  // faster than fpgettimeofday() which makes a syscall and don't use vDSO
  clock_gettime(CLOCK_REALTIME_FAST, @r);
  // + unixutil.TZSeconds = UTC to local time conversion
  EpochToSystemTime(r.tv_sec + TZSeconds, result);
  result.MilliSecond := PtrUInt(r.tv_nsec) div PtrUInt(NanoSecsPerMilliSec);
end;

function GetTickCount64: Int64;
var
  tp: timespec;
begin
  clock_gettime(CLOCK_MONOTONIC_FAST, @tp); // likely = CLOCK_MONOTONIC_COARSE
  // convert from nanoseconds into milliseconds
  result := QWord(PtrUInt(tp.tv_nsec) div PtrUInt(NanoSecsPerMilliSec)) +
            QWord(tp.tv_sec) * MilliSecsPerSec;
end;

function GetTickSec: cardinal;
var
  tp: timespec;
begin
  clock_gettime(CLOCK_MONOTONIC_FAST, @tp); // likely = CLOCK_MONOTONIC_COARSE
  result := tp.tv_sec; // no division needed
end;

function GetUptimeSec: cardinal;
var
  tp: timespec;
begin
  tp.tv_sec := 0;
  clock_gettime(CLOCK_UPTIME, @tp);
  result := tp.tv_sec;
end;

{$endif OSDARWIN}

function SetSystemTime(utctime: TUnixTime): boolean;
var
  u: timeval;
begin
  u.tv_sec := utctime;
  u.tv_usec := 0;
  result := fpsettimeofday(@u, nil) = 0;
end;

function UnixMSTimeUtcFast: TUnixMSTime;
begin
  result := UnixMSTimeUtc;
end;

{$undef HAS_PTHREADSETNAMENP}
{$undef HAS_PTHREADSETAFFINITY}

{$ifdef OSPTHREADSLIB}
var
  {$ifdef OSLINUX}
  // pthread_setname_np for Linux https://stackoverflow.com/a/7989973/458259
  {$define HAS_PTHREADSETNAMENP}
  pthread_setname_np: function(thread: pointer; name: PAnsiChar): integer; cdecl;
  // pthread_setaffinity_np has been tested on Linux only
  {$define HAS_PTHREADSETAFFINITY}
  pthread_setaffinity_np: function(thread: pointer;
    cpusetsize: SizeUInt; cpuset: pointer): integer; cdecl;
  {$endif OSLINUX}
  pthread_cancel: function(thread: pointer): integer; cdecl;
  pthread_mutex_init: function(mutex, attr: pointer): integer; cdecl;
  pthread_mutex_destroy: function(mutex: pointer): integer; cdecl;
{$endif OSPTHREADSLIB}

{$ifdef OSPTHREADSSTATIC}
  // note: pthread_setname_np() has no consistent API across POSIX systems

{$ifdef OSDARWIN}
// we specify link to clib='c' as in rtl/darwin/pthread.inc
function pthread_cancel(thread: pointer): integer;
  cdecl; external clib name 'pthread_cancel';
function pthread_mutex_init(mutex, attr: pointer): integer;
  cdecl; external clib name 'pthread_mutex_init';
function pthread_mutex_destroy(mutex: pointer): integer;
  cdecl; external clib name 'pthread_mutex_destroy';
function pthread_mutex_lock(mutex: pointer): integer;
  cdecl; external clib name 'pthread_mutex_lock';
function pthread_mutex_trylock(mutex: pointer): integer;
  cdecl; external clib name 'pthread_mutex_trylock';
function pthread_mutex_unlock(mutex: pointer): integer;
  cdecl; external clib name 'pthread_mutex_unlock';
{$else}
// just "external" without clib='c' as in rtl/*bsd/pthread.inc
function pthread_cancel(thread: pointer): integer;           cdecl; external;
function pthread_mutex_init(mutex, attr: pointer): integer;  cdecl; external;
function pthread_mutex_destroy(mutex: pointer): integer;     cdecl; external;
function pthread_mutex_lock(mutex: pointer): integer;        cdecl; external;
function pthread_mutex_trylock(mutex: pointer): integer;     cdecl; external;
function pthread_mutex_unlock(mutex: pointer): integer;      cdecl; external;
{$endif OSDARWIN}
{$endif OSPTHREADSSTATIC}


function IsInitializedCriticalSection(var cs: TRTLCriticalSection): boolean;
begin
  {$ifdef OSLINUX}
  result := cs.__m_kind <> 0;
  {$else}
  result := not IsZero(@cs, SizeOf(cs));
  {$endif OSLINUX}
end;

{$ifdef HAS_OSPTHREADS}

{ TOSLightLock }

procedure TOSLightLock.Init;
begin
  FillCharFast(self, SizeOf(self), 0); // may be bigger than pthread struct
  {$ifdef OSPTHREADSLIB}
  if not Assigned(pthread_mutex_init) then
    raise EOSException.Create('TOSLightLock.Init: no pthread_mutex_init')
    {$ifdef FPC} at get_caller_addr(get_frame), get_caller_frame(get_frame)
    {$else} at ReturnAddress {$endif}
  else // no recursive attribute -> fast mutex
  {$endif OSPTHREADSLIB}
    pthread_mutex_init(@fMutex, nil);
end;

procedure TOSLightLock.Done;
begin
  if IsInitializedCriticalSection(fMutex) then
    pthread_mutex_destroy(@fMutex);
end;

procedure TOSLightLock.Lock;
begin
  pthread_mutex_lock(@fMutex);
end;

function TOSLightLock.TryLock: boolean;
begin
  result := pthread_mutex_trylock(@fMutex) = 0;
end;

procedure TOSLightLock.UnLock;
begin
  pthread_mutex_unlock(@fMutex);
end;

{$else} // fallback to plain recursive TRTLCriticalSection

{ TOSLightLock }

procedure TOSLightLock.Init;
begin
  InitCriticalSection(fMutex);
end;

procedure TOSLightLock.Done;
begin
  DeleteCriticalSectionIfNeeded(fMutex);
end;

procedure TOSLightLock.Lock;
begin
  EnterCriticalSection(fMutex);
end;

function TOSLightLock.TryLock: boolean;
begin
  result := TryEnterCriticalSection(fMutex) <> 0;
end;

procedure TOSLightLock.UnLock;
begin
  LeaveCriticalSection(fMutex);
end;

{$endif HAS_OSPTHREADS}


procedure PosixSetThreadName(ThreadID: TThreadID; const Name: RawByteString);
var
  {%H-}trunc: array[0..15] of AnsiChar; // trunc to 16 non space chars (including #0)
  i, L, c4: integer;
begin
  if Name = '' then
    exit;
  L := 0; // trim unrelevant spaces and prefixes when filling the 16 chars
  i := 1;
  if Name[1] = 'T' then
  begin
    c4 := PCardinal(Name)^ and $dfdfdfdf;
    if (c4 = ord('T') + ord('S') shl 8 + ord('Q') shl 16 + ord('L') shl 24) or
       (c4 = ord('T') + ord('O') shl 8 + ord('R') shl 16 + ord('M') shl 24) then
      i := 5
    else
      i := 2;
  end;
  while i <= length(Name) do
  begin
    if Name[i] > ' ' then
    begin
      trunc[L] := Name[i];
      inc(L);
      if L = high(trunc) then
        break;
    end;
    inc(i);
  end;
  if L = 0 then
    exit;
  trunc[L] := #0;
  {$ifdef HAS_PTHREADSETNAMENP} // see https://stackoverflow.com/a/7989973
  {$ifdef OSPTHREADSLIB}
  if Assigned(pthread_setname_np) then
    try
      pthread_setname_np(pointer(ThreadID), @trunc[0]);
    except
      // ignore any exception (pthread confusion with its static version?)
      @pthread_setname_np := nil; // don't continue that way
    end;
  {$endif OSPTHREADSLIB}
  {$endif HAS_PTHREADSETNAMENP}
end;

procedure RawSetThreadName(ThreadID: TThreadID; const Name: RawUtf8);
begin
  if ThreadID <> MainThreadID then // don't change the main process name
    PosixSetThreadName(ThreadID, Name); // call pthread_setname_np()
end;

function RawKillThread(Thread: TThread): boolean;
begin
  result := false;
  {$ifdef OSPTHREADSLIB}
  if Assigned(pthread_cancel) then
    try
      result := pthread_cancel(pointer(Thread.ThreadID)) = 0;
    except
      // ignore any exception (pthread confusion with its static version?)
      @pthread_cancel := nil; // don't continue that way
    end;
  {$endif OSPTHREADSLIB}
  {$ifdef OSPTHREADSSTATIC}
  result := pthread_cancel(pointer(Thread.ThreadID)) = 0;
  {$endif OSPTHREADSSTATIC}
end;

procedure ResetCpuSet(out CpuSet: TCpuSet);
begin
  FillCharFast(CpuSet, SizeOf(CpuSet), 0);
end;

function SetThreadMaskAffinity(Thread: TThread; const Mask: TCpuSet): boolean;
begin
  result := false;
  {$ifdef HAS_PTHREADSETAFFINITY}
  {$ifdef OSPTHREADSLIB}
  if (Thread <> nil) and
     Assigned(pthread_setaffinity_np) then
    try
      result := pthread_setaffinity_np(
        pointer(Thread.ThreadID), SizeOf(Mask), @Mask) = 0;
    except
      // ignore any exception (pthread confusion with its static version?)
      @pthread_setaffinity_np := nil; // don't continue that way
    end;
  {$endif OSPTHREADSLIB}
  {$endif HAS_PTHREADSETAFFINITY}
end;

{$ifdef HAS_PTHREADSETAFFINITY}
function sched_getaffinity(pid: integer;
  cpusetsize: SizeUInt; cpuset: pointer): integer;
    cdecl external clib name 'sched_getaffinity';
{$endif HAS_PTHREADSETAFFINITY}

function GetMaskAffinity(out CpuSet: TCpuSet): boolean;
begin
  {$ifdef HAS_PTHREADSETAFFINITY}
  result := sched_getaffinity(0, SizeOf(CpuSet), @CpuSet) = 0;
  {$else}
  result := false; // unsupported by now
  {$endif HAS_PTHREADSETAFFINITY}
end;


{$ifndef NOEXCEPTIONINTERCEPT}

var
  _RawLogException: TOnRawLogException;

// FPC: intercept via the RaiseProc global variable
{$define WITH_RAISEPROC}
// RaiseProc redirection is implemented in main mormot.core.os.pas

{$endif NOEXCEPTIONINTERCEPT}

function FileDateToDateTime(const FileDate: TFileAge): TDateTime;
begin
  if FileDate <= 0 then
    result := 0
  else
    // + unixutil.TZSeconds = UTC to local time conversion
    result := Int64(FileDate + TZSeconds) / Int64(SecsPerDay) + Int64(UnixDelta);
end;

function FileAgeToDateTime(const FileName: TFileName): TDateTime;
begin
  // faster to use POSIX time than RTL FileDateToDateTime(FileAge())
  result := FileDateToDateTime(FileAgeToUnixTimeUtc(FileName)); // UTC to local
end;

function FileAgeToUnixTimeUtc(const FileName: TFileName; AllowDir: boolean): TUnixTime;
var
  st: TStat;
begin
  result := 0;
  if (FileName <> '') and
     (fpStat(pointer(FileName), st) = 0) and
     (AllowDir or
      (not FpS_ISDIR(st.st_mode))) then
    result := st.st_mtime; // as TUnixTime seconds, with no local conversion
end;

function ValidHandle(Handle: THandle): boolean;
begin
  result := PtrInt(Handle) >= 0; // 0=StdIn is a valid POSIX file descriptor
end;

function FileHandleToUnixTimeUtc(F: THandle): TUnixTime;
var
  st: TStat;
begin
  result := 0;
  if ValidHandle(F) and
     (FpFStat(F, st) = 0) then
    result := st.st_mtime;
end;

function FileSetDateFromUnixUtc(const Dest: TFileName; Time: TUnixTime): boolean;
var
  t: TUtimBuf;
begin
  result := false;
  if (Dest = '') or
     (Time = 0) then
    exit;
  t.actime := Time;
  t.modtime := Time;
  result := FpUtime(pointer(Dest), @t) = 0; // direct syscall
end;

function FileSetDateFrom(const Dest: TFileName; SourceHandle: THandle): boolean;
begin
  result := FileSetDateFromUnixUtc(Dest, FileHandleToUnixTimeUtc(SourceHandle));
end;

function FileSetDateFrom(const Dest, Source: TFileName): boolean;
begin
  result := FileSetDateFromUnixUtc(Dest, FileAgeToUnixTimeUtc(Source));
end;

function FileSetDateFromWindowsTime(const Dest: TFileName;
  WinTime: integer): boolean;
var
  dt: TDateTime;
begin
  dt := WindowsFileTimeToDateTime(WinTime);
  result := (Dest <> '') and
            (dt <> 0) and
            (FileSetDate(Dest, DateTimeToFileDate(dt)) = 0); // with LocalToEpoch()
end;

function SearchRecToWindowsTime(const F: TSearchRec): integer;
begin
  result := DateTimeToWindowsFileTime(FileDateToDateTime(F.{%H-}Time));
end;

function SearchRecToDateTime(const F: TSearchRec): TDateTime;
begin
  result := FileDateToDateTime(F.{%H-}Time);
end;

function SearchRecToUnixTimeUtc(const F: TSearchRec): TUnixTime;
begin
  result := F.{%H-}Time; // raw POSIX FileDate is already in UTC seconds
end;

function FileAgeToWindowsTime(F: THandle): integer;
begin
  result := DateTimeToWindowsFileTime(FileDateToDateTime(FileHandleToUnixTimeUtc(F)));
end;

function FileIsWritable(const FileName: TFileName): boolean;
begin
  result := (FileName <> '') and
            (fpaccess(pointer(FileName), W_OK) = 0);
  { access() does not answer the "can I read/write/execute this file?" question.
    It answers a slightly different question: "(assuming I'm a setuid binary)
    can the user who invoked me read/write/execute this file?" (man access) }
end;

function DeleteFile(const aFileName: TFileName): boolean;
begin
  result := (aFileName <> '') and
            (FpUnlink(pointer(aFileName)) >= 0);
end;

function RemoveDir(const aDirName: TFileName): boolean;
begin
  result := (aDirName <> '') and
            (FpRmdir(pointer(aDirName)) >= 0);
end;

procedure FileSetHidden(const FileName: TFileName; ReadOnly: boolean);
begin
  if FileName <> '' then
    if ReadOnly then
      fpchmod(pointer(FileName), S_IRUSR)
    else
      fpchmod(pointer(FileName), S_IRUSR or S_IWUSR);
end;

procedure FileSetSticky(const FileName: TFileName);
begin
  fpchmod(pointer(FileName), S_IRUSR or S_IWUSR or S_IRGRP or S_IROTH or S_ISVTX);
end;

function FileSize(const FileName: TFileName): Int64;
var
  st: TStat;
begin
  if (FileName = '') or
     (fpStat(pointer(FileName), st) <> 0) or
     FpS_ISDIR(st.st_mode) then
    result := 0
  else
    result := st.st_size;
end;

function FileExists(const FileName: TFileName; FollowLink, CheckAsDir: boolean): boolean;
var
  st: TStat;
begin
  result := false;
  if FileName = '' then
    exit;
  if FollowLink then
  begin
    if fpStat(pointer(FileName), st) <> 0 then
      exit;
  end
  else if fpLStat(pointer(FileName), st) <> 0 then
    exit;
  result := (FpS_ISDIR(st.st_mode) = CheckAsDir);
end;

function SetCurrentDir(const NewDir: TFileName): boolean;
begin
  result := (NewDir <> '') and
            (fpChdir(pointer(NewDir)) = 0);
end;

function FileCreate(const aFileName: TFileName; aMode, aRights: integer): THandle;
begin
  if aFileName = '' then
    result := 0
  else if (aMode = 0) and
          (aRights = 0) then
    result := sysutils.FileCreate(aFileName) // direct call of the FPC RTL
  else
  begin
    if aRights = 0 then // use 644 / '-rw-r-r--' default POSIX file attributes
      aRights := S_IRUSR or S_IWUSR or S_IRGRP or S_IROTH;
    result := sysutils.FileCreate(aFileName, aMode, aRights);
  end;
end;

procedure StatTimeMS(const st: TStat; out time: TUnixMSTime); inline;
begin
  time := QWord(st.st_mtime) * MilliSecsPerSec + // no local conversion needed
          // include milliseconds information
          {$ifdef OSLINUXANDROID}
          st.st_mtime_nsec div NanoSecsPerMilliSec;
          {$else}
          st.st_mtimensec div NanoSecsPerMilliSec;
          {$endif OSLINUXANDROID}
end;

function StatFileAttr(const fn: RawUtf8; const st: TStat): integer;
var
  p: PByteArray;
begin
  result := faArchive; // as LinuxToWinAttr() in fpcsrc/rtl/unix/sysutils.pp
  p := @PByteArray(fn)[GetLastDelimU(fn)]; // no memory allocation
  if FpS_ISDIR(st.st_mode) then
  begin
    result := result or faDirectory;
    if (p[0] = ord('.')) and
       (p[1] <> 0) and
       (PWord(@p[1])^ <> ord('.')) then
      result := result or faHidden{%H-}; // '.' and '..' are not hidden
  end
  else if p[0] = ord('.') then
    result := result or faHidden{%H-}; // e.g. '.htdigest'
  if (st.st_mode and S_IWUSR) = 0 then
    result := result or faReadOnly;
  if fpS_ISSOCK(st.st_mode) or
     fpS_ISBLK(st.st_mode) or
     fpS_ISCHR(st.st_mode) or
     fpS_ISFIFO(st.st_mode) Then
    result := result or faSysFile{%H-};
  if fpS_ISLNK(st.st_mode) then
    result := result or faSymLink{%H-};
end;

function FileInfoByName(const FileName: TFileName; out FileSize: Int64;
  out FileTimestampUtc: TUnixMSTime; FileAttr: PInteger): boolean;
var
  st: TStat;
begin
  result := (FileName <> '') and
            (fpStat(pointer(FileName), st) = 0);
  if not result then
    exit;
  if FpS_ISDIR(st.st_mode) then
    FileSize := -1
  else
    FileSize := st.st_size;
  StatTimeMS(st, FileTimestampUtc);
  if FileAttr <> nil then
    FileAttr^ := StatFileAttr(FileName, st);
end;

function FileSize(F: THandle): Int64;
var
  st: TStat;
begin
  if fpFstat(F, st) <> 0 then
    result := 0
  else
    result := st.st_size;
end;

function FileSeek64(Handle: THandle; const Offset: Int64; Origin: cardinal): Int64;
begin
  result := FPLSeek(Handle, Offset, Origin);
end;

function FileInfoByHandle(aFileHandle: THandle; FileId, FileSize: PInt64;
  LastWriteAccess, FileCreateDateTime: PUnixMSTime): boolean;
var
  mtime, atime, ctime: Int64;
  lp: TStat;
  r: integer;
begin
  r := FpFStat(aFileHandle, lp);
  result := r >= 0;
  if not result then
    exit;
  if FileId <> nil then
    FileId^ := lp.st_ino;
  if FileSize <> nil then
    FileSize^ := lp.st_size;
  if (LastWriteAccess = nil) and
     (FileCreateDateTime = nil) then
    exit;
  StatTimeMS(lp, mtime);
  if LastWriteAccess <> nil then
    LastWriteAccess^ := mtime;
  if FileCreateDateTime = nil then
    exit;
  // some FS don't populate all fields, so we use what we actually got
  {$ifdef OSOPENBSD}
  if (lp.st_birthtime <> 0) and
     (lp.st_birthtime < lp.st_ctime) then
    lp.st_ctime := lp.st_birthtime;
  {$endif OSOPENBSD}
  // ignore nanoseconds/Milliseconds for FileCreateDateTime
  ctime := Int64(lp.st_ctime) * MilliSecsPerSec;
  atime := Int64(lp.st_atime) * MilliSecsPerSec;
  if mtime <> 0 then
    if (ctime = 0) or
       (ctime > mtime) then
      ctime := mtime;
  if atime <> 0 then
    if (ctime = 0) or
       (ctime > atime) then
      ctime := atime;
  FileCreateDateTime^ := ctime;
end;

function FileIsExecutable(const FileName: TFileName): boolean;
var
  st: TStat;
begin
  result := (FileName <> '') and
            (fpStat(pointer(FileName), st) = 0) and
            (st.st_mode and (S_IXUSR or S_IXGRP or S_IXOTH) <> 0) and
            not FpS_ISDIR(st.st_mode);
end;

function FileIsSymLink(const FileName: TFileName): boolean;
var
  st: TStat;
begin
  result := (FileName <> '') and
            (fpStat(pointer(FileName), st) = 0) and
            fpS_ISLNK(st.st_mode) and
            not FpS_ISDIR(st.st_mode);
end;

var
  PosixProgramInfo: dl_info; // set at startup

procedure GetDlInfoName(var dlinfo: dl_info; var result: TFileName);
begin
  FastSetString(RawUtf8(result), dlinfo.dli_fname, StrLen(dlinfo.dli_fname));
  if (result <> '') and
     (result[1] <> '/') then
    result := ExpandFileName(string(result));
end;

function GetExecutableName(aAddress: pointer): TFileName;
var
  dlinfo: dl_info;
begin
  FillCharFast(dlinfo, sizeof(dlinfo), 0);
  dladdr(aAddress, @dlinfo);
  GetDlInfoName(dlinfo, result);
end;

function IsMainExecutable(aAddress: pointer): boolean;
var
  dlinfo: dl_info;
begin
  FillCharFast(dlinfo, sizeof(dlinfo), 0);
  dladdr(aAddress, @dlinfo);
  result := (dlinfo.dli_fbase = PosixProgramInfo.dli_fbase);
end;

function CopyFile(const Source, Target: TFileName; FailIfExists: boolean): boolean;
var
  src, dst: THandleStream;
  copied: Int64;
begin
  result := false;
  if FileExists(Target) then
    if FailIfExists then
      exit
    else
      DeleteFile(Target);
  src := FileStreamSequentialRead(Source);
  if src <> nil then
  try
    try
      dst := TFileStreamEx.Create(Target, fmCreate);
      try
        copied := StreamCopyUntilEnd(src, dst); // faster than dst.CopyFrom()
        result := copied = src.Size; // paranoid check
      finally
        dst.Free;
      end;
      if result then
        FileSetDateFrom(Target, src.Handle)
      else
        DeleteFile(Target);
    finally
      src.Free;
    end;
  except
    result := false;
    DeleteFile(Target); // remove any partial file
  end;
end;

function FileSymLink(const SymLink, Target: TFileName): boolean;
begin
  result := (SymLink <> '') and
            FileExists(Target) and
            (fpsymlink(pointer(Target), pointer(SymLink)) = 0);
end;

function WaitReadPending(fd, timeout: integer): boolean;
var
  p: TPollFD; // select() limits process to 1024 sockets in POSIX -> use poll()
  // https://moythreads.com/wordpress/2009/12/22/select-system-call-limitation
begin
  p.fd := fd;
  p.events := POLLIN or POLLPRI;
  p.revents := 0;
  result := FpPoll(@p, 1, timeout) > 0;
end;

procedure ConsoleErrorWrite(const text: RawUtf8);
begin
  FileWriteAll(StdErrorHandle, pointer(Text), length(Text)); // assume UTF-8
end;

function FileOpenSequentialRead(const FileName: TFileName): integer;
begin
  // SysUtils.FileOpen = fpOpen + fpFlock
  repeat
    result := fpOpen(pointer(FileName), O_RDONLY);  // no fpFlock() call
  until (result >= 0) or (fpgeterrno <> ESysEINTR); // see FPC FileOpen()
end;

function FileIsReadable(const aFileName: TFileName): boolean;
var
  fd: integer;
begin
  fd := FileOpenSequentialRead(aFileName); // no fpFlock() call
  result := ValidHandle(fd);
  if result then
    FileClose(fd);
end;

procedure SetEndOfFile(F: THandle);
begin
  FpFtruncate(F, FPLseek(F, 0, SEEK_CUR));
end;

procedure FlushFileBuffers(F: THandle);
begin
  FpFsync(F);
end;

function GetLastError: integer;
begin
  result := fpgeterrno;
end;

function IsSharedViolation(ErrorCode: integer): boolean;
begin
  if ErrorCode = 0 then
    ErrorCode := fpgeterrno;
  result := ErrorCode = ESysEACCES;
end;

procedure SetLastError(error: integer);
begin
  fpseterrno(error);
end;

procedure GetErrorShortVar(error: integer; var dest: ShortString);
begin
  OsErrorShort(error, @dest, {noint=}true); // known 'E###' on Linux + BSD
  if dest[0] = #0 then
    dest := StrError(error) // FPC RTL returns its plain text as shortstring
  else
  begin
    AppendShortTwoChars(ord(' ') + ord('(') shl 8, @dest);
    AppendShort(StrError(error), dest); // e.g. 'ECHILD (No child processes)'
    AppendShortChar(')', @dest);
  end;
end;

function TMemoryMap.DoMap(aCustomOffset: Int64): boolean;
begin
  if aCustomOffset <> 0 then
    if (aCustomOffset and (SystemInfo.dwPageSize - 1)) <> 0 then
      raise EOSException.CreateFmt(
        'DoMap(aCustomOffset=%d) incompatible with dwPageSize=%d',
        [aCustomOffset, SystemInfo.dwPageSize]);
  fBuf := fpmmap(nil, fBufSize, PROT_READ, MAP_SHARED, fFile, aCustomOffset);
  if fBuf = MAP_FAILED then
  begin
    fBuf := nil;
    result := false;
  end
  else
    result := true;
end;

procedure TMemoryMap.DoUnMap;
begin
  if (fBuf <> nil) and
     (fBufSize > 0) and
     (fFile <> 0) then
    fpmunmap(fBuf, fBufSize);
end;

// we tried sched_yield() on Linux, but since we spin for a while before calling
// SwitchToThread, it made more syscalls for no wallclock benefit: nanosleep(10us)
// seems a better solution, and also prevents pathological spinning if the
// scheduler policy actually is not adapted to this usage
{ $define OSLINUX_SCHEDYIELD}     // force sched_yield syscall on Linux
{ $define OSLINUX_SCHEDYIELDONCE} // yield once during DoSpin() - no benefit

{$ifdef OSLINUX_SCHEDYIELD}
procedure SwitchToThread;
begin
  // called more often than nanosleep, with no actual benefit
  Do_SysCall(syscall_nr_sched_yield); // properly defined in syscall.pp
end;
{$else}
procedure SwitchToThread;
var
  t: TTimeSpec;
begin
  // note: nanosleep() may flood the kernel with timer/scheduling events under
  // repeated calls - but here we spin-and-pause between calls so it is fine
  t.tv_sec := 0;
  t.tv_nsec := 1000; // 1us seems fair enough in respect to OS timers resolution
  fpnanosleep(@t, nil);
  // benchmarks show consistent 50us minimal for tiny requests, so 1us default
  // could prevent the kernel to jitter with too small intervals like 10ns
end;
{$endif OSLINUX_SCHEDYIELD}

procedure SleepHiRes(ms: cardinal);
var
  timeout: TTimespec;
  s: cardinal;
begin
  timeout.tv_sec := 0;
  if ms = 0 then
    // handle SleepHiRes(0) special case
    if SleepHiRes0Yield then
    begin
      // reported as unreliable by Alan on most POSIX, and despitable by Linus
      // - from our testing, it gives worse performance than fpnanosleep()
      // when waiting for some event (but may be sometimes used for spinning)
      ThreadSwitch; // FPC RTL redirects to pthread_yield()
      exit;
    end
    else
      timeout.tv_nsec := 10000 // 10us is around timer resolution on modern HW
  else if ms < 1000 then
    timeout.tv_nsec := ms * NanoSecsPerMilliSec
  else
  begin
    s := ms div MilliSecsPerSec;
    timeout.tv_sec := s;
    timeout.tv_nsec := (ms - s * MilliSecsPerSec) * NanoSecsPerMilliSec;
  end;
  fpnanosleep(@timeout, nil)
  // no retry loop on ESysEINTR (as with regular RTL's Sleep)
end;


{$undef HASEVENTFD}
{$undef HASGETRANDOM}
// eventfd + getrandom syscalls are validated on Linux i386, x86_64 and aarch64
{$ifdef OSLINUX}
  {$ifdef CPUX64}
    {$define HASEVENTFD}
    {$define HASGETRANDOM}
  {$endif CPUX64}
  {$ifdef CPUX86}
    {$define HASEVENTFD}
    {$define HASGETRANDOM}
  {$endif CPUX86}
  {$ifdef CPUAARCH64}
    {$define HASEVENTFD} 
    {$define HASGETRANDOM}
  {$endif CPUAARCH64}
{$endif OSLINUX}


{ TSynEvent }

constructor TSynEvent.Create;
begin
  {$ifdef HASEVENTFD}
  fFD := LinuxEventFD({nonblocking=}false, {semaphore=}false);
  if fFD = 0 then // fallback to PRTLEvent on oldest kernel
  {$endif HASEVENTFD}
    fHandle := RTLEventCreate;
end;

destructor TSynEvent.Destroy;
begin
  {$ifdef HASEVENTFD}
  if fFD <> 0 then
  begin
    LinuxEventFDWrite(fFD, 1); // release the lock or do nothing
    FileClose(fFD);
  end
  else
  {$endif HASEVENTFD}
    RTLEventDestroy(fHandle);
  inherited Destroy;
end;

procedure TSynEvent.ResetEvent;
begin
  fNotified := false;
  {$ifdef HASEVENTFD}
  if fFD = 0 then // no need to reset the eventfd() handle
  {$endif HASEVENTFD}
    RTLEventResetEvent(fHandle);
end;

procedure TSynEvent.SetEvent;
begin
  fNotified := true;
  {$ifdef HASEVENTFD}
  if fFD <> 0 then
    LinuxEventFDWrite(fFD, 1)
  else
  {$endif HASEVENTFD}
    RTLEventSetEvent(fHandle);
end;

function TSynEvent.WaitFor(TimeoutMS: integer): boolean;
begin
  {$ifdef HASEVENTFD}
  if fFD <> 0 then
  begin
    if WaitReadPending(fFD, TimeoutMS) then // = LinuxEventFDWait()
      LinuxEventFDRead(fFD);
  end
  else
  {$endif HASEVENTFD}
    RTLEventWaitFor(fHandle, TimeoutMS);
  result := fNotified;
end;

function TSynEvent.WaitForEver: boolean;
begin
  {$ifdef HASEVENTFD}
  if fFD <> 0 then
    LinuxEventFDRead(fFD)
  else
  {$endif HASEVENTFD}
    RTLEventWaitFor(fHandle);
  result := fNotified;
end;

function TSynEvent.IsEventFD: boolean;
begin
  {$ifdef HASEVENTFD}
  result := fFD <> 0;
  {$else}
  result := false;
  {$endif HASEVENTFD}
end;


procedure InitializeCriticalSection(var cs : TRTLCriticalSection);
begin
  InitCriticalSection(cs);
end;

procedure DeleteCriticalSection(var cs : TRTLCriticalSection);
begin
  DoneCriticalSection(cs);
end;

function GetFileOpenLimit(hard: boolean): integer;
var
  limit: TRLIMIT;
begin
  if fpgetrlimit(RLIMIT_NOFILE, @limit) = 0 then
    if hard then
      result := limit.rlim_max
    else
      result := limit.rlim_cur
  else
    result := -1;
end;

function SetFileOpenLimit(max: integer; hard: boolean): integer;
var
  limit: TRLIMIT;
begin
  result := -1;
  if fpgetrlimit(RLIMIT_NOFILE, @limit) <> 0 then
    exit;
  if (hard and
      (integer(limit.rlim_max) = max)) or
     (not hard and
      (integer(limit.rlim_cur) = max)) then
    exit(max); // already to the expected value
  if hard then
    limit.rlim_max := max
  else
    limit.rlim_cur := max;
  if fpsetrlimit(RLIMIT_NOFILE, @limit) = 0 then
    result := GetFileOpenLimit(hard);
end;


{$ifdef OSLINUXANDROID}
// https://www.cyberciti.biz/tips/tell-what-filesystems-linux-kernel-can-handle.html

var
  _ProcFileSystems: TRawUtf8DynArray; // from /proc/filesystems without "nodev"

function IsProcFileSystem(const typ: RawUtf8): boolean; inline;
begin
  result := FindNonVoidRawUtf8(pointer(_ProcFileSystems),
    pointer(typ), length(typ), length(_ProcFileSystems)) >= 0;
end;

function LoadProcFileSystems: boolean;
var
  fs, s: RawUtf8;
  p: PUtf8Char;
begin
  include(_F0, fProcFileSystemsTested);
  result := false;
  fs := StringFromFileNoSize('/proc/filesystems');
  p := pointer(fs);
  if p = nil then
    exit;
  repeat
    while p^ = ' ' do
      inc(p);
    s := _GetNextSpaced(p);
    if (s <> '') and
       (s <> 'nodev') and
       (s <> 'squashfs') and
       (s <> 'nullfs') then
      _AddRawUtf8(_ProcFileSystems, s);
    p := GotoNextLine(p);
  until p = nil;
  if _ProcFileSystems = nil then
    exit;
  // add some FS which may be marked as nodev but could be considered as "real"
  _AddRawUtf8(_ProcFileSystems, 'zfs');
  _AddRawUtf8(_ProcFileSystems, 'cifs');
  _AddRawUtf8(_ProcFileSystems, 'drvfs');
  result := true;
end;

{$endif OSLINUXANDROID}

{$ifdef OSLINUX} { the systemd, eventfd or getrandom APIs are Linux-specific }

const
  SD_NAMES: array[0..5] of PAnsiChar = (
    'sd_listen_fds',
    'sd_is_socket_unix',
    'sd_journal_print',
    'sd_journal_sendv',
    'sd_notify',
    'sd_watchdog_enabled');

  // eventfd2 syscall exists since Kernel 2.6.27, getrandom since Kernel 3.17
  {$ifdef CPUX64}
  syscall_nr_eventfd2  = 290;
  syscall_nr_getrandom = 318;
  {$endif CPUX64}
  {$ifdef CPUX86}
  syscall_nr_eventfd2  = 328;
  syscall_nr_getrandom = 355;
  {$endif CPUX86}
  // other archs (like aarch64) are properly defined - see https://syscall.sh


{ TSystemD }

procedure TSystemD.DoLoad;
var
  p: PPointer;
  i, j: PtrInt;
begin
  GlobalLock;
  if not tested then
  begin
    systemd := dlopen(LIBSYSTEMD_PATH, RTLD_LAZY);
    if systemd <> nil then
    begin
      p := @@listen_fds;
      for i := 0 to high(SD_NAMES) do
      begin
        p^ := dlsym(systemd, SD_NAMES[i]);
        if p^ = nil then
        begin
          p := @@listen_fds;
          for j := 0 to i do
          begin
            p^ := nil;
            inc(p);
          end;
          break;
        end;
        inc(p);
      end;
    end;
    tested := true;
  end;
  GlobalUnLock;
end;

function TSystemD.IsAvailable: boolean;
begin
  if not tested then
    DoLoad;
  result := Assigned(listen_fds);
end;

function TSystemD.ProcessIsStartedBySystemd: boolean;
begin
  result := IsAvailable and
    (fpgetppid() = 1) and // e.g. under Docker or when started by init.d
    (BaseUnix.fpGetenv(PAnsiChar('INVOCATION_ID')) <> nil); // as set e.g. on Ubuntu 20.04
end;

procedure TSystemD.Done;
begin
  if systemd <> nil then
  begin
    dlclose(systemd);
    systemd := nil;
  end;
end;

const
  PR_SET_NAME = 15; // see prctl.h

function LinuxSetProcessName(const NewName: RawUtf8): boolean;
var
  L: PtrInt;
  {%H-}trunc: array[0..15] of AnsiChar; // truncate to 16 chars (including #0)
begin
  L := MinPtrInt(15, length(NewName));
  MoveFast(NewName[1], trunc[0], L);
  trunc[L] := #0; // ending #0
  result := (KernelRevision >= $020609) and // since Kernel 2.6.9
            (do_syscall(syscall_nr_prctl, PR_SET_NAME, TSysParam(@trunc)) = 0);
end;

{$ifdef HASGETRANDOM} // validated on Linux i386, x86_64 and aarch64
function LinuxGetRandom(buf: pointer; len: PtrInt): boolean;
begin
  result := false;
  if not (fLinuxGetRandomFailed in _F0) then // KernelRevision checked at startup
    if do_syscall(syscall_nr_getrandom, TSysParam(buf), len, 0) = len then
    begin
      if len >= SizeOf(SystemEntropy.LiveFeed) then
        crcblock(@SystemEntropy.LiveFeed, buf); // quickly shuffle live state
      result := true; // "man getrandom" states to read up to 256 bytes per call
    end
    else
      include(_F0, fLinuxGetRandomFailed); // won't retry on syscall failure
end;
{$else}
function LinuxGetRandom(buf: pointer; len: PtrInt): boolean;
begin
  result := false;
end;
{$endif HASGETRANDOM}

{$ifdef HASEVENTFD} // validated on Linux i386, x86_64 and aarch64
const
  EFD_SEMAPHORE = $00000001;
  EFD_NONBLOCK  = O_NONBLOCK;
  EFD_CLOEXEC   = O_CLOEXEC;

function LinuxEventFD(nonblocking, semaphore: boolean): integer;
var
  f: cardinal;
begin
  if not (fLinuxEventFdFailed in _F0) then // KernelRevision checked at startup
  begin
    f := 0;
    if nonblocking then
      f := EFD_NONBLOCK;
    if semaphore then
      f := f or EFD_SEMAPHORE;
    result := do_syscall(syscall_nr_eventfd2, 0, f);
    if ValidHandle(result) then
      exit;
    include(_F0, fLinuxEventFdFailed); // don't retry next time
  end;
  result := 0;
end;

function LinuxEventFDRead(fd: integer): Int64;
var
  res: Int64; // need a local variable on i386
begin
  { If EFD_SEMAPHORE was specified and the eventfd counter has a nonzero value,
    then a read returns 8 bytes containing the value 1, and the counter's value
    is decremented by 1 }
  res := 0;
  if do_syscall(syscall_nr_read, fd, TSysParam(@res), SizeOf(res)) = SizeOf(res) then
    result := res
  else
    result := -1;
end;

procedure LinuxEventFDWrite(fd: integer; count: QWord);
begin
  if count <> 0 then
    do_syscall(syscall_nr_write, fd, TSysParam(@count), SizeOf(count));
end;

function LinuxEventFDWait(fd: integer; ms: integer): boolean;
begin
  result := WaitReadPending(fd, ms);
end;
{$else}
function LinuxEventFD(nonblocking, semaphore: boolean): integer;
begin
  result := 0; // non implemented (not validated by our tests) on this arch
end;

function LinuxEventFDRead(fd: integer): Int64;
begin
  result := -1;
end;

procedure LinuxEventFDWrite(fd: integer; count: QWord);
begin
end;

function LinuxEventFDWait(fd: integer; ms: integer): boolean;
begin
  result := false;
end;
{$endif HASEVENTFD}

{$endif OSLINUX}


// we bypass crt.pp since this unit cancels the SIGINT signal

var
  ConsoleCriticalSection: TOSLock; // too early to use TOSLightLock
  TextAttr: integer = -1; // always change the color at startup

procedure TestOnceDebuggerTty; forward;

function StdOutIsTTY: boolean;
begin
  if not (fIsDebuggerTested in _F0) then
    TestOnceDebuggerTty;
  result :=  (fStdOutIsTTY in _F0);
end;

procedure TextColorCmd(Color: TConsoleColor; var s: TShort7);
const
  TERM_CTRL: PUtf8Char = '04261537';
begin
  s[0] := #0;
  if (ord(Color) = TextAttr) or
     not StdOutIsTTY then
    exit;
  TextAttr := ord(Color);
  s := #27'[0;3#m';
  if ord(Color) >= 8 then
    s[3] := '1';
  s[6] := TERM_CTRL[(ord(Color) and 7)];
end;

procedure TextColorAppend(Color: TConsoleColor; var s: RawUtf8);
  {$ifdef HASINLINE} inline; {$endif}
var
  c: TShort7;
begin
  TextColorCmd(Color, c);
  AppendShortToUtf8(c, s);
end;

procedure TextColor(Color: TConsoleColor);
var
  c: TShort7;
begin
  TextColorCmd(Color, c);
  if c[0] = #0 then
    exit;
  ConsoleCriticalSection.Lock;
  fpwrite(StdOut, @c[1], ord(c[0])); // single syscall
  ConsoleCriticalSection.UnLock;
end;

procedure TextBackground(Color: TConsoleColor);
begin
  // not implemented yet - but not much needed either
end;

procedure ConsoleWrite(const Text: RawUtf8; Color: TConsoleColor;
  NoLineFeed, NoColor: boolean);
var
  s: RawUtf8;
begin
  // pre-compute the whole chars to be sent to the console
  NoColor := NoColor or (not StdOutIsTTY);
  if NoColor and
     NoLineFeed then
    s := Text // no memory allocation needed
  else
  begin
    if not NoColor then
      TextColorAppend(Color, s);
    AppendBufferToUtf8(pointer(Text), length(Text), s);
    if not NoLineFeed then
      AppendShortToUtf8(#10, s);
    if not NoColor then
      TextColorAppend(ccLightGray, s);
  end;
  // display whole line in a single syscall, and within our global lock
  ConsoleCriticalSection.Lock;
  FileWriteAll(StdOut, pointer(s), length(s)); // UTF-8 console
  ConsoleCriticalSection.UnLock;
end;

function UnixKeyPending: boolean;
begin
  result := WaitReadPending(StdInputHandle, 0);
end;

{$I-}
procedure ConsoleWaitForEnterKey;
var
  c: AnsiChar;
begin
  if GetCurrentThreadID = MainThreadID then
  begin
    SynDaemonIntercept; // intercept ^C and SIGQUIT - do nothing if already set
    repeat
      if IsMultiThread then
        CheckSynchronize(100)
      else
        SleepHiRes(100);
      if SynDaemonTerminated <> 0 then
        break;
      if UnixKeyPending then
        repeat
          c := #0;
          if FpRead(StdInputHandle, c, 1) <> 1 then
            break;
          if c in [#10, #13] then
            exit;
        until false;
    until false;
  end
  else
  begin
    ReadLn;
    ioresult;
  end;
end;
{$I+}

function ConsoleStdInputLen: integer;
begin
  if fpioctl(StdInputHandle, FIONREAD, @result) < 0 then
    result := 0;
end;

function Utf8ToConsole(const S: RawUtf8): RawByteString;
begin
  result := S; // expect a UTF-8 console under Linux/BSD
end;


{$ifdef FPCUSEVERSIONINFO} // FPC 3.0+ if enabled in .inc / project options
function TFileVersion.RetrieveInformationFromFileName: boolean;
var
  v: TVersionInfo;
  i, j: integer;
  key, value: string;
begin
  result := false;
  if fFileName = '' then
    exit;
  v := TVersionInfo.Create;
  try
    try
      // extract information - v.Load() may raise EResNotFound
      if (fFileName <> '') and
         (fFileName <> ParamStr(0)) then
        v.Load(fFileName)
      else
        v.Load(HInstance); // load info for currently running program
      result := v.FixedInfo.FileVersion[0] <> 0;
      // set extracted version numbers
      SetVersion(v.FixedInfo.FileVersion[0],
                 v.FixedInfo.FileVersion[1],
                 v.FixedInfo.FileVersion[2],
                 v.FixedInfo.FileVersion[3]);
      // detect translation
      if v.VarFileInfo.Count > 0 then
        with v.VarFileInfo.Items[0] do
          LanguageInfo := _fmt('%.4x%.4x', [language, codepage]);
      if LanguageInfo = '' then
      begin
        // take first language
        i := 0;
        if v.StringFileInfo.Count > 0 then
          LanguageInfo := v.StringFileInfo.Items[0].Name
      end
      else
      begin
        // look for language index
        i := v.StringFileInfo.Count - 1;
        while (i >= 0) and
              (CompareText(v.StringFileInfo.Items[i].Name, LanguageInfo) <> 0) do
          dec(i);
        if i < 0 then
        begin
          i := 0; // revert to first translation
          LanguageInfo := v.StringFileInfo.Items[i].Name;
        end;
      end;
      with v.StringFileInfo.Items[i] do
        for j := 0 to Count - 1 do
        begin
          key := Keys[j];
          value := Trim(ValuesByIndex[j]);
          if key = 'CompanyName' then
            CompanyName := value
          else if key = 'FileDescription' then
            FileDescription := value
          else if key = 'FileVersion' then
            FileVersion := value
          else if key = 'InternalName' then
            InternalName := value
          else if key = 'LegalCopyright' then
            LegalCopyright := value
          else if key = 'OriginalFilename' then
            OriginalFilename := value
          else if key = 'ProductName' then
            ProductName := value
          else if key = 'ProductVersion' then
            ProductVersion := value
          else if key = 'Comments' then
            Comments := value;
        end;
    except
      // trap EResNotFound exception from v.Load()
    end;
  finally
    v.Free;
  end;
end;
{$else}
function TFileVersion.RetrieveInformationFromFileName: boolean;
begin
  result := false; // nothing to be done
end;
{$endif FPCUSEVERSIONINFO}

function GetEnv(name: PAnsiChar; var env: RawUtf8): boolean;
begin
  name := BaseUnix.FPGetenv(name); // local GetEnvironmentVariable()
  result := name <> nil;
  if result then
    FastSetString(env, name, StrLen(name));
end;

procedure GetUserHost(out User, Host: RawUtf8);
begin
  Host := SystemInfo.uts.nodename;
  if Host = '' then
    GetEnv('HOSTNAME', Host);
  if not GetEnv('LOGNAME', User) then // POSIX
    GetEnv('USER', User);
end;

function GetEnvFolder(name: PAnsiChar; var folder: TFileName;
  writable: boolean): boolean;
begin
  if GetEnv(name, RawUtf8(folder)) then
    if writable and
       not FileIsWritable(folder) then
      folder := ''
    else
      folder := IncludeTrailingPathDelimiter(folder);
  result := folder <> '';
end;

function WritableFolder(const parent, sub: TFileName; var folder: TFileName): boolean;
begin
  result := false;
  folder := EnsureDirectoryExists(Join([parent, sub]));
  if folder = '' then
    exit;
  if FileIsWritable(folder) then
    result := true
  else
    folder := '';
end;

function IsExpandedPath(const FileName: TFileName): boolean;
begin
  result := (FileName = '') or
            ((FileName[1] = '/') and
             (Pos('..', FileName) = 0)); // seems already expanded
end;

procedure _ComputeSystemPath(kind: TSystemPath; var result: TFileName);
begin
  result := ''; // "out result" param is not enough for FPC
  case kind of
    spLog:
         // try '/var/log/<exename>'
      if not WritableFolder('/var/log/', TFileName(Executable.ProgramName), result) and
         // try '<exepath>/log'
         not WritableFolder(Executable.ProgramFilePath, 'log', result) then
        // fallback to '$TMP/<exename>-log' - spUserData/$HOME is no option
        result := EnsureDirectoryExists(format('%s%s-log',
          [GetSystemPath(spTemp), Executable.ProgramName]));
    // warning: $HOME is reported wrong with sudo for spUserData/spUserDocuments
    spUserData:
         // try $XDG_CACHE_HOME
      if not GetEnvFolder('XDG_CACHE_HOME', result, {writable=}true) and
         // try '$HOME/.cache'
         not WritableFolder(GetSystemPath(spUserDocuments), '.cache', result) then
        // fallback to '$TMP/<user>'
        WritableFolder(GetSystemPath(spTemp), TFileName(Executable.User), result);
    spTemp:
      begin
        // try $TMPDIR (POSIX standard) and $TMP and $TEMP
        if GetEnvFolder('TMPDIR', result, {writable=}true) or
           GetEnvFolder('TMP',    result, {writable=}true) or
           GetEnvFolder('TEMP',   result, {writable=}true) then
          exit;
        // try /tmp
        result := '/tmp/';
        if not FileIsWritable(result) then
          // fallback to /var/tmp
          result := '/var/tmp/';
      end;
  else
    // POSIX requires a value for the $HOME environment variable
    GetEnvFolder('HOME', result, {writable=}false);
  end;
end;

function _GetSystemStoreAsPem(CertStore: TSystemCertificateStore): RawUtf8;
var
  files: TRawUtf8DynArray;
  f: PtrInt;
begin
  // see https://go.dev/src/crypto/x509/root_unix.go as reference
  case CertStore of
    scsRoot:
      result := StringFromFirstFile([
        {$ifdef OSLINUXANDROID}
          '/etc/ssl/certs/ca-certificates.crt',                // Debian/Gentoo
      	  '/etc/pki/tls/certs/ca-bundle.crt',                  // Fedora/RHEL 6
          '/etc/ssl/ca-bundle.pem',                            // OpenSUSE
          '/etc/pki/tls/cacert.pem',                           // OpenELEC
          '/etc/pki/ca-trust/extracted/pem/tls-ca-bundle.pem', // CentOS/RHEL 7
          '/etc/ssl/cert.pem'                                  // Alpine Linux
        {$else}
      	  '/usr/local/etc/ssl/cert.pem',            // FreeBSD
      	  '/etc/ssl/cert.pem',                      // OpenBSD
      	  '/usr/local/share/certs/ca-root-nss.crt', // DragonFly
      	  '/etc/openssl/certs/ca-certificates.crt'  // NetBSD
        {$endif OSLINUXANDROID}
        ]);
    scsCA:
      begin
        files := StringFromFolders([
          {$ifdef OSLINUXANDROID}
            '/etc/ssl/certs',               // Debian/SLES10/SLES11
            '/etc/pki/tls/certs',           // Fedora/RHEL
      	    '/system/etc/security/cacerts'  // Android
          {$else}
            '/etc/ssl/certs',         // FreeBSD 12.2+
            '/usr/local/share/certs', // FreeBSD
            '/etc/openssl/certs'      // NetBSD
          {$endif OSLINUXANDROID}
          ]);
        for f := 0 to length(files) - 1 do
          if (PosEx('-----BEGIN', files[f]) <> 0) and
             IsAnsiCompatible(files[f]) and
             (PosEx(files[f], result) = 0) then // append PEM files once
            result := Join([result, #10, files[f]]);
      end;
  end;
end;


const
  // on POSIX, we store the SMBIOS data in a local cache for non-root users
  SMB_CACHE = '/var/tmp/.synopse.smb';
  SMB_FLAGS = $010003ff; // assume 3.0 SMB is good enough
  // local storage of fallback UUID
  UUID_CACHE = '/var/tmp/.synopse.uid';
  // note: /var/tmp is cleaned up by systemd after 30 days so we set S_ISVTX
  //   see https://systemd.io/TEMPORARY_DIRECTORIES

{$ifdef CPUINTEL}
const
  // potential location of the SMBIOS buffer pointers within a 64KB fixed frame
  SMB_START  = $000f0000;
  SMB_STOP   = $00100000;

function GetSmbEfiMem: RawByteString; forward; // Linux/BSD dedicated versions
function SearchSmbios(const mem: RawByteString; var info: TRawSmbiosInfo): PtrUInt;
  forward; // implemented later in mormot.core.os.pas

function GetRawSmbiosFromMem(var info: TRawSmbiosInfo): boolean;
var
  mem: RawByteString;
  addr: PtrUInt;
  {$ifdef OSLINUX}
  fromsysfs: boolean;
  {$endif OSLINUX}
begin
  result := false;
  {$ifdef OSLINUX}
  // on Linux, first try from sysfs tables
  fromsysfs := false;
  mem := StringFromFileNoSize('/sys/firmware/dmi/tables/smbios_entry_point');
  if mem <> '' then
    fromsysfs := true
  else
  {$endif OSLINUX}
    // then try to read system EFI entries
    mem := GetSmbEfiMem;
  if mem = '' then
    // last fallback to raw memory reading (won't work on modern/EFI systems)
    mem := ReadSystemMemory(SMB_START, SMB_STOP - SMB_START);
  if mem = '' then
    exit;
  addr := SearchSmbios(mem, info);
  if addr = 0 then
    exit;
  {$ifdef OSLINUX}
  if fromsysfs then
    info.data := StringFromFileNoSize('/sys/firmware/dmi/tables/DMI')
  else
  {$endif OSLINUX}
    info.data := ReadSystemMemory(addr, info.Length);
  result := info.data <> '';
end;
{$endif CPUINTEL}

function _GetRawSmbios(var info: TRawSmbiosInfo): boolean;
begin
  {$ifdef CPUINTEL}
  result := GetRawSmbiosFromMem(info);
  if result then
    exit;
  {$else} // do not mess with low-level RAM buffer scanning on ARM/AARCH64
  result := false; // untested and reported as clearly faulty on some platforms
  {$endif CPUINTEL}
  PCardinal(@info)^ := SMB_FLAGS; // mark as retrieved from cache
  info.Data := StringFromFile(SMB_CACHE); // cache is better than PosixInject
  if (info.Data <> '') and
     (CompressSynLZ(info.Data, {compress=}false) = '') then
    info.Data := ''; // tampered file
  if info.Data = '' then
    if Assigned(PosixInject.GetSmbiosData) then
    begin
      info.Data := PosixInject.GetSmbiosData; // e.g. from mormot.core.os.mac
      if info.Data <> '' then
        PCardinal(@info)^ := SMB_FLAGS - 1; // mark retrieved from PosixInject
    end;
  if info.Data = '' then
    exit;
  info.Length := length(info.Data);
  result := true;
end;

procedure PosixInjectSmbiosInfo(var info: TSmbiosBasicInfos);
var
  i: TSmbiosBasicInfo;
begin
  if Assigned(PosixInject.GetSmbios) then // e.g. from mormot.core.os.mac
    for i := succ(low(i)) to high(i) do
      if info[i] = '' then
        info[i] := PosixInject.GetSmbios(i);
end;

procedure _AfterDecodeSmbios(var info: TRawSmbiosInfo);
var
  s: RawByteString;
begin
  // complete information e.g. from mormot.core.os.mac
  if Assigned(PosixInject.GetSmbios) then
    PosixInjectSmbiosInfo(_Smbios);
  // check if require persistence after some HW changes
  if (PCardinal(@info)^ = SMB_FLAGS) or
     (CompressSynLZGetHash32(StringFromFile(SMB_CACHE)) = Hash32(info.Data)) then
    exit;
  // cache raw SMBIOS data for non-root users
  s := info.Data;
  CompressSynLZ(s, true); // SynLZ + Hash32 to avoid tampered file
  FileFromString(s, SMB_CACHE);
  FileSetSticky(SMB_CACHE);
  DeleteFile(UUID_CACHE); // this file is now superfluous and maybe inconsistent
end;

function SeemsRealPointer(p: pointer): boolean;
begin
  // let the GPF happen silently in the kernel (validated on Linux only)
  result := (PtrUInt(p) > 65535) and
            (fpaccess(p, F_OK) <> 0) and
            (fpgeterrno <> ESysEFAULT);
end;

const
  DT_UNKNOWN  = 0; // need to call fpstat() if this is returned (depends on FS)
  DT_FIFO     = 1;
  DT_CHR      = 2;
  DT_DIR      = 4;
  DT_BLK      = 6;
  DT_REG      = 8;
  DT_LNK      = 10;
  DT_SOCK     = 12;
  DT_WHT      = 14;

function PosixFileNames(const Folder: TFileName; Recursive: boolean;
  OnFile: TOnPosixFileName; OnFileOpaque: pointer;
  ExcludesDir, IncludeHiddenFiles, IncludeFolders: boolean): TRawUtf8DynArray;
var
  n: PtrInt;
  root: TFileName;

  procedure DoFolder(const subpath: TFileName);
  var
    dir: pDir;
    ent: pDirent;
    entlen, subcount, i: integer;
    addedpath: TFileName;
    fn: PByteArray; // is a temp RawUtf8
    sub: TRawUtf8DynArray;

    procedure MakeFileName(const path: TFileName);
    var
      plen: PtrInt;
    begin
      if path <> '' then // fn := path + d_name
      begin
        plen := length(path);
        fn := FastNewString(plen + entlen, CP_UTF8);
        MoveFast(pointer(path)^, fn^, plen);
        MoveFast(ent^.d_name, fn[plen], entlen);
      end
      else
      begin
        fn := FastNewString(entlen, CP_UTF8);
        MoveFast(ent^.d_name, fn^, entlen); // fn := d_name
      end;
    end;

  begin
    // read all the file or directory names of this folder
    subcount := 0;
    Join([root, subpath], RawUtf8(addedpath));
    dir := FpOpendir(pointer(addedpath)); // faster than FindFirst()
    if dir = nil then
      exit;
    if ExcludesDir then
      addedpath := subpath;
    repeat
      ent := FpReaddir(dir^); // FPC RTL use getdents64 syscall on Linux and BSD :)
      if ent = nil then
        break;
      // handle this entry type
      entlen := StrLen(@ent^.d_name);
      case ent^.d_type of
        DT_UNKNOWN, // assume modern FS over BSD or Linux Kernel >= 2.6.4
        DT_REG:
          if Assigned(OnFile) and
             not OnFile(OnFileOpaque, ent^.d_name, entlen) then
            continue // e.g. no MatchAnyP()
          else if (not IncludeHiddenFiles) and
                  (ent^.d_name[0] = '.') then
            continue;
        DT_DIR:
          begin
            if (ent^.d_name[0] = '.') and
               ((not IncludeHiddenFiles) or
                (ent^.d_name[1] = #0) or
                (PWord(@ent^.d_name[1])^ = ord('.'))) then
              continue; // ignore hidden or '.' or '..' folders
            if Recursive then
            begin
              MakeFileName(subpath);
              with PStrRec(PAnsiChar(fn) - _STRRECSIZE)^ do
              begin
                fn[length] := ord('/'); // full nested path/ in sub[]
                inc(length);
              end;
              if subcount = length(sub) then
                SetLength(sub, NextGrow(subcount));
              pointer(sub[subcount]) := fn;
              inc(subcount);
            end;
            if not IncludeFolders then
              continue;
            if Assigned(OnFile) and
               not OnFile(OnFileOpaque, ent^.d_name, entlen) then
              continue; // simulate a FindFirst(mask) as in FindFilesRtl()
          end;
      else
        continue; // not a real file (e.g. link, sysproc or blockdev)
      end;
      if n = 0 then // generous initial result capacity
        SetLength(result, 128)
      else if n = length(result) then
        SetLength(result, NextGrow(n));
      MakeFileName(addedpath);
      pointer(result[n]) := fn;
      inc(n);
    until false;
    FpClosedir(dir^);
    // now process the sub-folders recursively outside of FpOpendir/FpCLoseDir
    for i := 0 to subcount - 1 do
      DoFolder(sub[i]);
  end;

begin
  result := nil;
  n := 0;
  root := IncludeTrailingPathDelimiter(Folder);
  DoFolder('');
  if n <> 0 then
    DynArrayFakeLength(result, n);
end;

var
  argv0len: PtrInt;

function PosixSetProcessName(const Name: RawUtf8): boolean;
begin
  result := false;
  if (Name = '') or
     not IsAnsiCompatible(Name) then
    exit;
  if argv0len = 0 then
    argv0len := StrLen(argv[0]); // retrieve once to keep the max possible size
  {$ifdef OSLINUX} // untested (probably unsafe?) on Android
  if LinuxSetProcessName(Name) then // first try with the prctl syscall
    result := true
  else
  {$endif OSLINUX}
  try
    MoveFast(pointer(Name)^, argv[0]^, MinPtrInt(argv0len, length(Name)) + 1);
    result := true;
  except
    result := false; // catch any GPF
  end;
end;

{$ifdef OSBSDDARWIN}

procedure OsErrorShort(Code: cardinal; Dest: PShortString; NoInt: boolean);
begin
  BsdErrorShort(Code, Dest, NoInt);
end;

function IsValidPid(pid: cardinal): boolean;
begin
  result := pid <> 0;
end;

function EnumAllProcesses: TCardinalDynArray;
begin
  result := nil;
  // not implemented yet on BSD/Darwin
  // - fpsysctl with CTL_KERN + KERN_PROC + KERN_PROC_ALL is highly OS dependent
  // and headers are over-complicated so almost impossible to safely use in FPC:
  // https://github.com/apple-opensource/xnu/blob/master/bsd/sys/sysctl.h#L975
  // https://stackoverflow.com/a/6945542/458259
  // - kvm_openfiles / kvm_getprocs may be a good option:
  // https://kaashif.co.uk/2015/06/18/how-to-get-a-list-of-processes-on-openbsd-in-c
end;

function EnumProcessName(PID: cardinal): RawUtf8;
begin
  result := ''; // not implemented yet on BSD/Darwin
  // use fpsysctl with CTL_KERN + KERN_PROC + KERN_PROC_PID
  //  https://man.openbsd.org/sysctl.2#KERN_PROC_PID
  // another trouble is that the name is likely to be truncated to 16 chars
  // because it is defined p_comm[MAXCOMLEN + 1] in the very complex headers
end;

function _IsDebuggerPresent: boolean;
begin
  // rough detection for FPC on BSD (not yet working because of EnumProcessName)
  result := PosEx('lazarus', LowerCase(EnumProcessName(FpGetppid))) <> 0;
end;

function GetParentProcess(PID: cardinal): cardinal;
begin
  if PID = 0 then
    result := FpGetppid // we have a system call for the currrent process :)
  else
    result := 0; // not implemented yet on BSD/Darwin
end;

function bsdsysctl(node, id: cint; dest: pointer; len: cint): cint; overload;
var
  mib: array[0..1] of cint;
begin
  mib[0] := node;
  mib[1] := id;
  result := len;
  if fpsysctl(pointer(@mib), 2, dest, @result, nil, 0) <> 0 then
    result := 0;
end;

function bsdsysctl(name: PAnsiChar; dest: pointer; len: cint): cint; overload;
begin
  result := len;
  if FPsysctlbyname(name, dest, @result, nil, 0) <> 0 then
    result := 0;
end;

function fpsysctlhwint(hwid: cint): Int64;
begin
  result := 0;
  bsdsysctl(CTL_HW, hwid, @result, SizeOf(result));
end;

function fpsysctlhwstr(hwid: cint; var temp: ShortString): PUtf8Char;
begin
  FillCharFast(temp, SizeOf(temp), 0); // ShortString as 0-terminated buffer
  if (bsdsysctl(CTL_HW, hwid, @temp, SizeOf(temp)) <> 0) and
     (temp[0] <> #0) then
    result := @temp
  else
    result := nil;
end;

function fpsysctlbynamestr(name: PAnsiChar; var temp: ShortString): PUtf8Char;
begin
  FillCharFast(temp, SizeOf(temp), 0); // ShortString as 0-terminated buffer
  if (bsdsysctl(name, @temp, SizeOf(temp)) <> 0) and
     (temp[0] <> #0) then
    result := @temp
  else
    result := nil;
end;

type
  TLoadAvg = array[0..2] of double;

function getloadavg(var loadavg: TLoadAvg; nelem: integer): integer;
  cdecl external clib name 'getloadavg';

function RetrieveLoadAvg: TShort23;
var
  avg: TLoadAvg;
begin
  result[0] := #0;
  if getloadavg(avg, 3) <> 3 then
    exit;
  AppendShort(TwoDigits(avg[0]), result);
  AppendShortChar(' ', @result);
  AppendShort(TwoDigits(avg[1]), result);
  AppendShortChar(' ', @result);
  AppendShort(TwoDigits(avg[2]), result);
end; // we didn't use AppendShortCurr64() because of expected rounding

function GetMemoryInfo(out info: TMemoryInfo; withalloc: boolean): boolean;
begin
  FillCharFast(info, SizeOf(info), 0);
  info.memtotal := SystemMemorySize; // retrieved at startup
  info.memfree := info.memtotal - fpsysctlhwint(HW_USERMEM);
  result := info.memtotal <> 0;// avoid div per 0 exception
  if result then
    info.percent := ((info.memtotal - info.memfree) * 100) div info.memtotal;
end;

type
  // emulate sysinfo() Linux syscall on BSD/Mac
  TSysInfo = packed record
    uptime: cardinal;                    // Seconds since boot
    loads: array[0 .. 2] of cardinal;    // 1, 5, and 15 minute load averages
    totalram: cardinal;                  // Total usable main memory size
    freeram: cardinal;                   // Available memory size
    bufferram: cardinal;                 // Memory used by buffers
    totalswap: cardinal;                 // Total swap space size
    freeswap: cardinal;                  // swap space still available
    mem_unit: cardinal;                  // Memory unit size in bytes
  end;

function RetrieveSysInfo(var si: TSysInfo): boolean;
var
  avg: TLoadAvg;
  i: PtrInt;
begin
  FillCharFast(si, SizeOf(si), 0);
  si.uptime := GetUptimeSec;
  if getloadavg(avg, 3) = 3 then
    for i := 0 to 2 do
      si.loads[i] := Trunc(avg[i] * 65536.0);
  si.totalram := SystemMemorySize shr 12;
  si.freeram := (SystemMemorySize - fpsysctlhwint(HW_USERMEM)) shr 12;
  si.mem_unit := 1 shl 12; // 4096
  result := true; // bufferram and totalswap/freeswap are left with 0
end;

{$ifdef OSFREEBSD}

const
  KENV_GET = 0;
  KENV_SET = 1;

function kenv(action: integer; name, value: PAnsiChar; len: integer): integer;
  cdecl external clib name 'kenv';

function GetSmbEfiMem: RawByteString;
var
  tmp: TByteToAnsiChar;
  xaddr: PtrUInt;
begin
  result := '';
  if kenv(KENV_GET, 'hint.smbios.0.mem', @tmp, SizeOf(tmp)) < 0 then
    exit;
  xaddr := ParseHex0x(@tmp); // typical value is '0xf05b0'
  if xaddr <> 0 then
    result := ReadSystemMemory(xaddr, 1024); // 32 bytes is enough
end;

const
  _KNOWN: array[0..14] of record
    id: TSmbiosBasicInfo;
    fn: RawUtf8;
  end = (
    (id: sbiBiosVendor;        fn: 'bios.vendor'),
    (id: sbiBiosVersion;       fn: 'bios.version'),
    (id: sbiBiosDate;          fn: 'bios.reldate'),
    (id: sbiManufacturer;      fn: 'system.maker'),
    (id: sbiProductName;       fn: 'system.product'),
    (id: sbiVersion;           fn: 'system.version'),
    (id: sbiSerial;            fn: 'system.serial'),
    (id: sbiUuid;              fn: 'system.uuid'),
    (id: sbiSku;               fn: 'system.sku'),
    (id: sbiFamily;            fn: 'system.family'),
    (id: sbiBoardManufacturer; fn: 'planar.maker'),
    (id: sbiBoardProductName;  fn: 'planar.product'),
    (id: sbiBoardVersion;      fn: 'planar.version'),
    (id: sbiBoardSerial;       fn: 'planar.serial'),
    (id: sbiBoardAssetTag;     fn: 'planar.tag')
  );

procedure _DirectSmbiosInfo(out info: TSmbiosBasicInfos);
var
  i: PtrInt;
  tmp: TByteToAnsiChar;
begin
  for i := 0 to high(_KNOWN) do
    with _KNOWN[i] do
      if kenv(KENV_GET, PAnsiChar('smbios.' + fn), @tmp, SizeOf(tmp)) >= 0 then
        info[id] := TrimU(tmp);
end;

type
  TBsdProcTimes = array[0 .. 4] of clong; // user/nice/system/int/idle

procedure BsdProcTimes(var times: TBsdProcTimes);
begin
  bsdsysctl('kern.cp_time', @times, SizeOf(times));
end;

{$else}

// help is needed to implement those on buggy Mac OS
// may fallback to PosixInject wrappers from mormot.core.os.mac

function GetSmbEfiMem: RawByteString;
begin
  result := '';
end;

{$ifdef OSDARWIN}
function ReadSystemMemory(address, size: PtrUInt): RawByteString;
begin
  result := '';
end;
{$endif OSDARWIN}

procedure _DirectSmbiosInfo(out info: TSmbiosBasicInfos);
begin
 // info[sbiUuid] := fpsysctlbynamestr('kern.uuid', tmp); // <> SMBios value :(
end;

{$endif OSFREEBSD}

{$ifdef OSDARWIN}

function RetrieveSystemTimes(out IdleTime, KernelTime, UserTime: Int64): boolean;
var
  proccount, infocount: cardinal;
  info: PCardinalArray; // per User/System/Idle/Nice quad
begin
  result := false;
  IdleTime := 0;
  KernelTime := 0;
  UserTime := 0;
  proccount := 0;
  infocount := 0;
  info := nil;
  if (host_processor_info(mach_host_self, PROCESSOR_CPU_LOAD_INFO,
       proccount, info, infocount) <> 0) or
     (proccount = 0) or
     (infocount <> proccount * 4) or
     (info = nil) then
    exit;
  repeat
    //writeln('U:',info[0],' S:', info[1],' I:', info[2],' N:', info[3]);
    inc(UserTime,   info[0] + info[3]);  // CPU_STATE_USER + CPU_STATE_NICE
    inc(KernelTime, info[1]);            // CPU_STATE_SYSTEM
    inc(IdleTime,   info[2]);            // CPU_STATE_IDLE
    info := @info[4];                    // next cpu
    dec(proccount);
  until proccount = 0;
  inc(KernelTime, IdleTime); // as with GetSystemTimes() WinAPI
  result := (UserTime + KernelTime) <> 0;
  //writeln('I:',IdleTime,',K:',KernelTime,',U:',UserTime,'  result=',result);
end;

procedure XorOSEntropy(var e: THash512Rec);
var
  mem: TMemoryInfo;
  tix1: UInt64         absolute mem.memtotal; // in ticks (ns) resolution
  tix2: UInt64         absolute mem.memfree;
  avg: TLoadAvg        absolute mem.memfree;  // array[0..2] of double
  proccount: cardinal  absolute mem.vmfree;
  infocount: cardinal  absolute mem.percent;
  info: PCardinalArray absolute mem.allocused;
begin
  // some minimal OS entropy we could get on Darwin
  tix1 := tix1 xor mach_absolute_time;        // monotonic hi-res clock
  getloadavg(avg, 3);                         // system stats
  DefaultHasher128(@e.h0, @mem, SizeOf(mem)); // include values on stack
  GetMemoryInfo(mem, {withalloc=}false);      // also fill mem with zeros
  DefaultHasher128(@e.h1, @mem, SizeOf(mem));
  infocount := 0;
  host_processor_info(mach_host_self,         // detailed per-cpu times
    PROCESSOR_CPU_LOAD_INFO, proccount, info, infocount);
  DefaultHasher128(@e.h2, pointer(info), infocount * SizeOf(info^[0]));
  tix1 := mach_continuous_time;               // wall clock time since boot
  tix2 := mach_absolute_time;                 // should have changed in-between
  crcblock(@e.h3, @mem);                      // another algo
end;

{$else}

function RetrieveSystemTimes(out IdleTime, KernelTime, UserTime: Int64): boolean;
var
  times: TBsdProcTimes;
begin
  // on BSD, use kern.cp_time 0=user/1=nice/2=system/3=interrupt/4=idle values
  // see https://man.openbsd.org/sysctl.2#KERN_CPTIME~2
  // - note: this does not work on MacOS - we use host_processorinfo() instead
  // https://freebsd-hackers.freebsd.narkive.com/DBF0kxOC/cpu-utilization-break-down-via-sysctl#post3
  FillCharFast(times, SizeOf(times), 0);
  BsdProcTimes(times);
  UserTime   := times[0] + times[1];
  KernelTime := times[2] + times[3] + times[4]; // krn includes idl as on Windows
  IdleTime   := times[4];
  result := (UserTime + KernelTime) <> 0;
end;

procedure XorOSEntropy(var e: THash512Rec);
var
  mem: TMemoryInfo;
  tp: timespec         absolute mem;          // in nanoseconds resolution
  avg: TLoadAvg        absolute mem.memtotal; // array[0..2] of double
  times: TBsdProcTimes absolute mem.vmtotal;  // array[0..4] of clong
begin
  // some minimal high-res OS entropy we could get on BSD
  clock_gettime(CLOCK_MONOTONIC_HIRES, @tp);  // fast VDSO call
  DefaultHasher128(@e.h0, @tp, SizeOf(tp));   // may be AesNiHash128
  GetMemoryInfo(mem, {withalloc=}false);      // also fill mem with zeros
  DefaultHasher128(@e.h1, @mem, SizeOf(mem));
  getloadavg(avg, 3);                         // system stats
  BsdProcTimes(times);                        // cpu stats
  DefaultHasher128(@e.h2, @mem, SizeOf(mem));
  clock_gettime(CLOCK_MONOTONIC_HIRES, @tp);  // should have changed in-between
  crcblock(@e.h3, @tp);                       // another algo
end;

{$endif OSDARWIN}

{$else} // Linux (and Android) specific code

procedure OsErrorShort(Code: cardinal; Dest: PShortString; NoInt: boolean);
begin
  LinuxErrorShort(Code, Dest, NoInt);
end;

procedure FindNameValue(p: PUtf8Char; const up: ShortString; var res: RawUtf8);
var
  L: PtrInt;
begin
  while p <> nil do
    if IdemPChar(p, @up[1]) then
    begin
      inc(p, ord(up[0]));
      while (p^ <= ' ') and
            (p^ <> #0) do
        inc(p); // trim left
      L := 0;
      while p[L] > #13 do
        inc(L);
      while p[L - 1] = ' ' do
        dec(L); // trim right
      FastSetString(res, p, L);
      exit;
    end
    else
      p := GotoNextLine(p);
  FastAssignNew(res);
end;

function FindNameValueCardinal(p: PUtf8Char; const up: ShortString): PtrUInt;
begin
  while p <> nil do
    if IdemPChar(p, @up[1]) then // agressively inlined on FPC
    begin
      inc(p, ord(up[0]));
      result := GetCardinal(p);
      exit;
    end
    else
      p := GotoNextLine(p);
  result := 0;
end;

{$ifdef CPUARM3264}
procedure ParseHex32Add(p: PAnsiChar; var result: TIntegerDynArray);
var
  v: integer;
begin
  v := ParseHex0x(p);
  if v <> 0 then
    AddInteger(result, v, {nodup=}true);
end;
{$endif CPUARM3264}

function ParseLine(P: PUtf8Char): PUtf8Char;
begin
  if P <> nil then
    P := strscan(P, ':');
  result := P;
  if P = nil then
    exit;
  repeat
    inc(P);
  until (P^ = #0) or
        (P^ > ' ');
  result := P;
  while not (ord(P^) in [0, 10, 13]) do
  begin
    if P^ < ' ' then
      P^ := ' '; // change any tab into space
    inc(P);
  end;
  P^ := #0; // make asciiz
end;

function ParseInt(P: PUtf8Char): integer;
begin
  P := ParseLine(P);
  if (P <> nil) and
     (P^ in ['0'..'9']) then
    result := GetCardinal(P)
  else
    result := -1;
end;

function StringFromFileNoSize(const FileName: TFileName): RawByteString;
var
  h: THandle;
  pos, read: PtrInt;
  tmp: array[0..$7fff] of AnsiChar; // 32KB stack buffer
begin
  result := '';
  if FileName = '' then
    exit;
  h := FileOpenSequentialRead(FileName); // no fpFlock() call
  if PtrInt(h) <= 0 then
    exit;
  pos := 0;
  repeat
    read := FileRead(h, tmp[pos], SizeOf(tmp) - pos); // try to fill the buffer
    if read <= 0 then
      break; // end of input
    inc(pos, read);
    if pos < SizeOf(tmp) then // is likely to flush before 32KB of output
      continue;
    AppendBufferToUtf8(@tmp, pos, RawUtf8(result)); // in-place resize
    pos := 0;
  until false;
  if pos <> 0 then
    AppendBufferToUtf8(@tmp, pos, RawUtf8(result));
  FileClose(h);
end;

function LoadProcFile(fn: PAnsiChar; var dest: TBuffer4K): PtrInt;
var
  h: THandle;
begin
  result := 0;
  repeat
    h := FpOpen(fn, O_RDONLY); // no fpFlock() call
  until (PtrInt(h) >= 0) or (fpgeterrno <> ESysEINTR); // as FileOpen()
  if PtrInt(h) <= 0 then
    exit;
  result := FileRead(h, dest, SizeOf(dest) - 1); // read up to 4KB
  if result >= 0 then
    dest[result] := #0
  else
    result := 0; // don't return length = -1 on reading error
  FileClose(h);
end;

procedure LoadProcFileTrimed(fn: PAnsiChar; var result: RawUtf8);
var
  buf: TBuffer4K; // reading up to 4KB of content is enough
  p: PAnsiChar;
  l: PtrInt;
begin
  l := LoadProcFile(fn, buf);
  p := @buf;
  while (l > 0) and
        (p[0] <= ' ') do // trim left
  begin
    dec(l);
    inc(p);
  end;
  while (l > 0) and
        (p[l - 1] <= ' ') do // trim right
    dec(l);
  FastSetString(result, p, l);
  if result = 'Default string' then // e.g. on ProxMox containers or VMs
    result := '';
end;

function LoadProcFileTrim(fn: PAnsiChar): RawUtf8;
begin
  LoadProcFileTrimed(fn, result);
end;

procedure FindFileValue(fn: PAnsiChar; const up: ShortString; var res: RawUtf8);
var
  buf: TBuffer4K; // reading up to 4KB of content is enough
begin
  LoadProcFile(fn, buf);
  FindNameValue(@buf, up, res);
end;

function FindFileCardinal(fn: PAnsiChar; const up: ShortString): PtrUInt;
var
  buf: TBuffer4K; // reading up to 4KB of content is enough
begin
  LoadProcFile(fn, buf);
  result := FindNameValueCardinal(@buf, up)
end;

function FindPidStatus(pid: cardinal; const up: ShortString): cardinal;
var
  fn: ShortString; // avoid any memory allocation
begin
  fn := '/proc/';
  AppendShortCardinal(pid, fn);
  AppendShort('/status'#0, fn);
  result := FindFileCardinal(@fn[1], up);
end;

function IsValidPid(pid: cardinal): boolean;
begin
  // ensure is a real process, not a thread
  // https://www.memsql.com/blog/the-curious-case-of-thread-groups-identifiers
  result := (pid <> 0) and
            (FindPidStatus(pid, 'TGID:') = pid);
end;

function EnumAllProcesses: TCardinalDynArray;
var
  d: pDir;
  e: pDirent;
  n: integer;
  pid: cardinal;
begin
  result := nil;
  d := FpOpendir(PAnsiChar('/proc')); // faster alternative to FindFirst()
  if d = nil then
    exit;
  n := 0;
  SetLength(result, 128);
  repeat
    e := FpReaddir(d^); // FPC RTL uses direct getdents syscall on Linux/BSD :)
    if e = nil then
      break;
    if (e.d_type in [DT_UNKNOWN, DT_DIR]) and
       (e.d_name[0] in ['1'..'9']) then
    begin
      pid := GetCardinal(@e.d_name[0]);
      if IsValidPid(pid) then
        AddInteger(TIntegerDynArray(result), n, pid);
    end;
  until false;
  FpClosedir(d^);
  if n = 0 then
    result := nil
  else
    DynArrayFakeLength(result, n);
end;

function EnumProcessName(PID: cardinal): RawUtf8;
var
  fn: ShortString;
  tmp: TBuffer4K;
  n: AnsiChar;
begin
  result := '';
  if PID = 0 then
    exit;
  fn := '/proc/';
  AppendShortCardinal(PID, fn);
  n := fn[0];
  if not (fNoTryProcExe in _F1) then
  begin
    // may need to be root to follow /fn/[pid]/exe
    AppendShort('/exe'#0, fn);
    result := fpReadLink(PChar(@fn[1])); // a single syscall is fine
    if result <> '' then
      exit;
  end;
  fn[0] := n;
  AppendShort('/cmdline'#0, fn);
  LoadProcFile(@fn[1], tmp);
  // set of strings separated by null bytes -> exe is the first argument
  FastSetString(result, pointer(@tmp), StrLen(pointer(@tmp)));
  if result <> '' then
    include(_F1, fNoTryProcExe); // no need to try again next time
end;

function IsNotCurrentExeDaemonized(PID: cardinal): boolean;
begin
  result := PosEx(Executable.ProgramName, EnumProcessName(PID)) = 0;
end;

function GetParentProcess(PID: cardinal): cardinal;
begin
  if PID = 0 then
    result := FpGetppid // we have a system call for the current process :)
  else
    result := FindPidStatus(PID, 'PPID:');
end;

function _IsDebuggerPresent: boolean;
begin
  result := FindFileCardinal('/proc/self/status', 'TRACERPID:') <> 0;
end;

function RetrieveLoadAvg: TShort23;
var
  si: TSysInfo;  // Linuxism
begin
  result[0] := #0;
  if SysInfo(@si) <> 0 then // one syscall is faster than /proc/loadavg access
    exit;
  AppendShort(TwoDigits(si.loads[0] / double(65536.0)), result);
  AppendShortChar(' ', @result);
  AppendShort(TwoDigits(si.loads[1] / double(65536.0)), result);
  AppendShortChar(' ', @result);
  AppendShort(TwoDigits(si.loads[2] / double(65536.0)), result);
end; // we didn't use AppendShortCurr64() because of expected rounding

function RetrieveSysInfo(var si: TSysInfo): boolean;
begin // single syscall gives enough information on Linux
  result := SysInfo(@si) = 0;
end;

function RetrieveSystemTimes(out IdleTime, KernelTime, UserTime: Int64): boolean;
var
  P: PUtf8Char;
  tmp: TBuffer4K;
begin
  result := false;
  // see http://www.linuxhowtos.org/System/procstat.htm
  if LoadProcFile('/proc/stat', tmp) <= 10 then
    exit;
  P := @tmp;
  // e.g. 'cpu  3418147 18140 265232 6783435 12184 0 34219 0 0 0'
  UserTime   := _GetNextCardinal(P){=user} + _GetNextCardinal(P){=nice};
  KernelTime := _GetNextCardinal(P){=system};
  IdleTime   := _GetNextCardinal(P){=idle};
  inc(KernelTime, IdleTime); // as with GetSystemTimes() WinAPI
  result := (UserTime + KernelTime) <> 0;
end;

function GetMemoryInfo(out info: TMemoryInfo; withalloc: boolean): boolean;
var
  tmp: TBuffer4K;
  P: PUtf8Char;
begin
  result := false;
  FillCharFast(info, SizeOf(info), 0);
  // sysinfo() syscall has not enough information: use /proc sysfiles
  if LoadProcFile('/proc/meminfo', tmp) <= 0 then
    exit;
  P := @tmp;
  info.memtotal  := QWord(FindNameValueCardinal(P, 'MEMTOTAL:')) shl 10;
  info.memfree   := QWord(FindNameValueCardinal(P, 'MEMAVAILABLE:')) shl 10;
  info.filetotal := QWord(FindNameValueCardinal(P, 'SWAPTOTAL:')) shl 10;
  info.filefree  := QWord(FindNameValueCardinal(P, 'SWAPFREE:')) shl 10;
  // note: Windows-like virtual memory information is not available under Linux
  info.vmtotal   := QWord(FindNameValueCardinal(P, 'COMMITLIMIT:')) shl 10;
  info.vmfree    := QWord(FindNameValueCardinal(P, 'MEMFREE:')) shl 10;
  if info.memfree = 0 then // kernel < 3.14 may not have the MemAvailable field
    info.memfree  := info.vmfree + QWord(
                       FindNameValueCardinal(P, 'BUFFERS:') +
                       FindNameValueCardinal(P, 'CACHED:')  +
                       FindNameValueCardinal(P, 'SRECLAIMABLE:') -
                       FindNameValueCardinal(P, 'SHMEM:')) shl 10;
  if info.memtotal <> 0 then
  begin
    info.percent := ((info.memtotal - info.memfree) * 100) div info.memtotal;
    result := true;
  end;
  if not withalloc then
    exit;
  // GetHeapStatus is only about current thread -> use /proc/[pid]/statm
  if LoadProcFile('/proc/self/statm', tmp) <= 0 then
    exit;
  P := @tmp;
  info.allocreserved := QWord(_GetNextCardinal(P)) * SystemInfo.dwPageSize; // VmSize
  info.allocused     := QWord(_GetNextCardinal(P)) * SystemInfo.dwPageSize; // VmRSS
end;

procedure XorOSEntropy(var e: THash512Rec);
var
  tmp: TBuffer4K;
  si: TSysInfo  absolute tmp; // Linuxism
  rt: TTimeSpec absolute tmp; // in nanoseconds resolution
begin
  clock_gettime(CLOCK_MONOTONIC_HIRES, @rt);
  DefaultHasher128(@e.h0, @rt, SizeOf(rt)); // maybe AesNiHash128
  SysInfo(@si); // uptime + loadavg + meminfo + numprocess
  DefaultHasher128(@e.h0, @si, SizeOf(si));
  // detailed CPU execution context and timing from Linux kernel
  DefaultHasher128(@e.h0, @tmp, LoadProcFile('/proc/self/statm', tmp));
  DefaultHasher128(@e.h0, @tmp, LoadProcFile('/proc/self/stat', tmp));
  DefaultHasher128(@e.h0, @tmp, LoadProcFile('/proc/self/io', tmp));
  DefaultHasher128(@e.h1, @tmp, LoadProcFile('/proc/stat', tmp));
  clock_gettime(CLOCK_UPTIME, @rt);
  DefaultHasher128(@e.h2, @rt, SizeOf(rt));
  clock_gettime(CLOCK_MONOTONIC_HIRES, @rt); // should have changed in-between
  DefaultHasher128(@e.h3, @rt, SizeOf(rt));
  {$ifdef HASGETRANDOM}
  // eventually XOR with 512-bit getrandom syscall if available
  if LinuxGetRandom(@tmp, SizeOf(e)) then
    XorMemory(@e, @tmp, SizeOf(e))
  else
  {$endif HASGETRANDOM}
    // read-only 122-bit random UUID text '6fd5a44b-35f4-4ad4-a9b9-6b9be13e1fe9'
    DefaultHasher128(@e.h2, @tmp, LoadProcFile('/proc/sys/kernel/random/uuid', tmp));
end;

{$ifdef OSANDROID}

procedure _DirectSmbiosInfo(out info: TSmbiosBasicInfos);
begin
end;

{$else} // pure Linux

const
  // read some of the /sys/class/dmi/id/* files (may require root access)
  _KNOWN: array[0..15] of record
    id: TSmbiosBasicInfo;
    fn: string[15];
  end = (
    (id: sbiBiosVendor;        fn: 'bios_vendor'),
    (id: sbiBiosVersion;       fn: 'bios_version'),
    (id: sbiBiosDate;          fn: 'bios_date'),
    (id: sbiBiosRelease;       fn: 'bios_release'),
    (id: sbiManufacturer;      fn: 'sys_vendor'),
    (id: sbiProductName;       fn: 'product_name'),
    (id: sbiVersion;           fn: 'product_version'),
    (id: sbiSerial;            fn: 'product_serial'),
    (id: sbiUuid;              fn: 'product_uuid'),
    (id: sbiSku;               fn: 'product_sku'),
    (id: sbiFamily;            fn: 'product_family'),
    (id: sbiBoardManufacturer; fn: 'board_vendor'),
    (id: sbiBoardProductName;  fn: 'board_name'),
    (id: sbiBoardVersion;      fn: 'board_version'),
    (id: sbiBoardSerial;       fn: 'board_serial'),
    (id: sbiBoardAssetTag;     fn: 'board_asset_tag')
  );

procedure _DirectSmbiosInfo(out info: TSmbiosBasicInfos);
var
  i: PtrInt;
  n: ShortString;
begin
  n := '/sys/class/dmi/id/';
  for i := 0 to high(_KNOWN) do
    with _KNOWN[i] do
    begin
      n[0] := #18;
      AppendShort(fn, n);
      AppendShortChar(#0, @n);
      LoadProcFileTrimed(@n[1], info[id]);
    end;
  // note: /var/lib/dbus/machine-id and /etc/machine-id are SW generated from
  // random at system install so do NOT match sbiUuid HW DMI value - see
  // https://www.freedesktop.org/software/systemd/man/machine-id.html
end;

{$endif OSANDROID}

{$endif OSBSDDARWIN}

procedure TestOnceDebuggerTty;
var
  term: RawUtf8;
begin
  include(_F0, fIsDebuggerTested);
  if _IsDebuggerPresent then // actual syscall
    include(_F0, fIsDebuggerPresent);
  if (not (fIsDebuggerPresent in _F0)) and
     (IsATTY(StdOut) = 1) and
     GetEnv('TERM', term) and
     IdemPChars(term, ['XTERM', 'SCREEN', 'TMUX', 'RXVT', 'LINUX', 'CYGWIN']) then
    include(_F0, fStdOutIsTTY);
end;

function IsDebuggerPresent: boolean;
begin
  if not (fIsDebuggerTested in _F0) then
    TestOnceDebuggerTty;
  result := fIsDebuggerPresent in _F0;
end;

{$ifdef OSDARWIN}
{$if defined(cpuarm) or defined(cpuaarch64) or defined(iphonesim)}
const // FPC RTL defined wrong field lengths for TStatfs in darwin/ptypes.inc
  MFSTYPENAMELEN = 16;

type // see https://keith.github.io/xcode-man-pages/statfs.2.html
  TStatfs = record
    bsize: cuint32;
    iosize: cint32;
    blocks: cuint64;
    bfree: cuint64;
    bavail: cuint64;
    files: cuint64;
    ffree: cuint64;
    fsid: fsid_t;
    owner: uid_t;
    ftype: cuint32;
    fflags: cuint32;
    fssubtype: cuint32;
    fstypename:  array[0 .. MFSTYPENAMELEN - 1] of AnsiChar;
    mountpoint:  array[0 .. PATH_MAX - 1]       of AnsiChar;
    mntfromname: array[0 .. PATH_MAX - 1]       of AnsiChar;
    reserved:    array[0 .. 7] of cuint32;
  end;
{$ifend}
{$else}
// on POSIX systems, /dev/mem may be available from root
// but sometimes even root can't access it on hardened systems
function ReadSystemMemory(address, size: PtrUInt): RawByteString;
var
  mem: cInt;
  map: PAnsiChar;
  off: PtrUInt;
begin
  result := '';
  if size > 4 shl 20 then
    exit; // read up to 4MB
  mem := FileOpenSequentialRead('/dev/mem');
  if mem <= 0 then
    exit;
  // Fpmmap() is more complex but works around problems using plain read() calls
  off := address mod SystemInfo.dwPageSize;
  map := Fpmmap(nil, off + size, PROT_READ, MAP_SHARED, mem, address - off);
  if map <> MAP_FAILED then
  begin
    FastSetRawByteString(result, map + off, size);
    Fpmunmap(map, off + size);
  end;
  FileClose(mem);
end;
{$endif OSDARWIN}

procedure DirectSmbiosInfo(out info: TSmbiosBasicInfos);
begin
  // retrieve OS-dependent information
  _DirectSmbiosInfo(info);
  // normalize some entries
  info[sbiUuid] := LowerCase(info[sbiUuid]);
  // some missing info may have retrieved at startup of this unit
  if info[sbiCpuVersion] = '' then
    info[sbiCpuVersion] := CpuInfoText;
  // e.g. from mormot.core.os.mac
  if Assigned(PosixInject.GetSmbios) then
    PosixInjectSmbiosInfo(info);
end;

function RetrieveProcessInfo(PID: cardinal; out KernelTime, UserTime: Int64;
  out WorkKB, VirtualKB: cardinal): boolean;
begin
  result := false;
end;

function TProcessInfo.Init: boolean;
begin
  FillCharFast(self, SizeOf(self), 0);
  result := false;
end;

function TProcessInfo.Start: boolean;
begin
  result := false;
end;

function TProcessInfo.PerProcess(PID: cardinal; Now: PDateTime;
  out Data: TSystemUseData; var PrevKernel, PrevUser: Int64): boolean;
begin
  result := false;
end;

function TProcessInfo.PerSystem(out Idle, Kernel, User: single): boolean;
var
  I, K, U, S: Int64;
begin
  result := false;
   if not RetrieveSystemTimes(I, K, U) then
    exit;
  S := U + K + I;
  if S = 0 then
    exit;
  Kernel := {%H-}SimpleRoundTo2Digits((K * 100) / S);
  User   := {%H-}SimpleRoundTo2Digits((U * 100) / S);
  Idle   := 100 - Kernel - User; // ensure sum is always 100%
  result := true;
end; { TODO : use a diff approach for TProcessInfo.PerSystem on Linux? }

procedure __Fill256FromOs(out e: THash256Rec);
var
  si: TSysInfo;  // Linuxism, but properly emulated by thit unit on Mac/BSD
begin
  {$ifdef HASGETRANDOM}
  // try to get whole 256-bit from OS crypto-PRNG in 1 syscall
  if LinuxGetRandom(@e, SizeOf(e)) then
    exit;
  {$endif HASGETRANDOM}
  // no FillSystemRandom() to avoid endless recursive calls in XorEntropy()
  {$ifdef OSDARWIN} // OSX has no clock_gettime() API
  e.d0 := mach_absolute_time   * 2654435761;
  e.d1 := mach_continuous_time * 3266489917;
  {$else}
  if SizeOf(timespec) <= SizeOf(e) then // paranoid (max 128-bit) -> no-op
    clock_gettime(CLOCK_MONOTONIC_FAST, @e); // fast VDSO call
  {$endif OSDARWIN}
  crcblock(@e.l, @SystemEntropy.LiveFeed); // obfuscate
  RetrieveSysInfo(si); // at least uptime + cpu load + free mem on all OS
  DefaultHasher128(@e.h, @si, SizeOf(si)); // maybe AesNiHash128
  {$ifndef CPUINTEL}
  if SystemEntropy.LiveFeed.c0 = 0 then       // may happen on BSD and MAC ARM
    crcblocks(@SystemEntropy.LiveFeed, @e, 2) // put something here
  else
  {$endif CPUINTEL}
    crcblock(@e.h, @SystemEntropy.Startup);  // obfuscate
end;

const
  // FillSystemRandom() retrieves 256 bytes max (2048-bit) from the OS API
  // - "man urandom" Usage states that 256-bit makes sense for /dev/urandom - as
  // it is usually called in our framework, e.g. from TAesPrng.GetEntropy
  // - but we pushed the limit up since it may be called by TBigInt.FillPrime to
  // generate e.g. 4096-bit RSA keys which requires one 2048-bit random number
  // - "man getrandom" states that the Linux syscall can always return 256 bytes
  MAXFROMOS = 256;

function FillSystemRandom(Buffer: PByteArray; Len: integer;
  AllowBlocking: boolean): boolean;
var
  rd, dev: integer;
begin
  result := false;
  if Len <= 0 then
    exit;
  // retrieve up to MAXFROMOS=256 bytes max
  rd := MinPtrInt(Len, MAXFROMOS);
  {$ifdef HASGETRANDOM} // a single syscall to rule them all on Linux
  result := LinuxGetRandom(Buffer, rd);
  if not result then
  {$endif HASGETRANDOM}
  begin
    dev := 0;
    if not (fNoURandom in _F0) then
      // /dev/urandom non blocking on Linux, but may block at boot time on BSD
      dev := FileOpenSequentialRead('/dev/urandom');
    if dev <= 0 then
    begin
      include(_F0, fNoURandom); // don't try any more (may be a chroot system)
      if AllowBlocking and // paranoid: any decent POSIX system has /dev/urandom
         not (fNoRandom in _F0) then
      begin
        if rd > 16 then
          rd := 16; // better to get only 128-bit from raw blocking /dev/random
        dev := fpOpen('/dev/random', O_RDONLY);
        if dev <= 0 then
          include(_F0, fNoRandom); // not worth trying any more
      end;
    end;
    if dev > 0 then // we can read some bytes from /dev/urandom or /dev/random
    begin
      result := (fpRead(dev, Buffer^, rd) = rd); // may block until entropy
      FileClose(dev);
      if result and
         (rd >= SizeOf(SystemEntropy.LiveFeed)) then
        crcblock(@SystemEntropy.LiveFeed, pointer(Buffer));
    end;
  end;
  if result then
  begin
    dec(Len, rd);
    if Len = 0 then
      exit;
    // diffusion/padding of remaining bytes > rd=MAXFROMOS=256 (unlikely)
    LecuyerDiffusion(@Buffer[MAXFROMOS], Len, pointer(Buffer)); // gsl_rng_taus2
  end
  else
    // on OS API call failure (paranoid): fallback to TLecuyer
    // - keep result=false if the Buffer^ was not really filled from OS
    SharedRandom.Fill(Buffer, Len);
end;

function GetDiskInfo(var aDriveFolderOrFile: TFileName;
  out aAvailableBytes, aFreeBytes, aTotalBytes: QWord): boolean;
var
  fs: TStatfs; // TStatfs may be redefined above for darwin aarch64
begin
  if aDriveFolderOrFile = '' then
    aDriveFolderOrFile := '.';
  FillCharFast(fs, SizeOf(fs), 0);
  result := fpStatFS(pointer(aDriveFolderOrFile), @fs) = 0;
  aAvailableBytes := QWord(fs.bavail) * QWord(fs.bsize);
  aFreeBytes := aAvailableBytes; // no user Quota involved here
  aTotalBytes := QWord(fs.blocks) * QWord(fs.bsize);
end;

function IsRealFileSystem(const typ: RawUtf8): boolean;
begin
  {$ifdef OSLINUXANDROID}
  if _ProcFileSystems <> nil then   // caller made LoadProcFileSystems once
    result := IsProcFileSystem(typ) // from /proc/filesystems
  else
  {$endif OSLINUXANDROID}
    // generic / best guess fallback list
    result := not IdemPChars(typ, ['AUTOFS', 'PROC', 'SUBFS', 'DEBUGFS',
      'DEVPTS', 'FUSECTL', 'MQUEUE', 'RPC-PIPEFS', 'SYSFS', 'DEVFS', 'KERNFS',
      'PTY', 'IGNORE', 'NONE', 'TMPFS', 'SECURITYFS', 'RAMFS', 'ROOTFS',
      'DEVTMPFS', 'HUGETLBFS', 'ISO9660']);
end;

procedure AddDiskPartition(const typ, mnt, fs: RawUtf8;
  var result: TDiskPartitions; var n:PtrInt);
var
  av, fr, tot: QWord;
  fn: TFileName;
begin
  //writeln('AddDiskPartition typ=',typ,' mnt=',mnt,' fs=',fs);
  if (fs = '') or
     (mnt = '') or
     (typ = '') or
     (fs = 'rootfs') or
     (mnt = '/mnt') or
     IdemPChar(pointer(fs), '/DEV/LOOP') or
     IdemPChars(mnt, ['/PROC/', '/SYS/', '/RUN/']) or
     not IsRealFileSystem(typ) then
    exit;
  fn := mnt;
  //writeln('GetDiskInfo=',GetDiskInfo(fn, av, fr, tot));
  //writeln('fs=',fs,' mnt=',fn,' typ=',typ, ' av=',KB(av),' fr=',KB(fr),' tot=',KB(tot));
  if not (GetDiskInfo(fn, av, fr, tot)) or
     (tot < 1 shl 20) then
    exit;
  if n = length(result) then
    SetLength(result, NextGrow(n));
  with result[n] do
  begin
    name := fs;
    mounted := fn;
    size := tot;
  end;
  inc(n);
end;

// we tried with libc setmntent/getmntent but it is Linux only :(
// and Darwin has no /etc/mtab - so we use the getfsstat() BSD/Mac API

{$ifdef OSBSDDARWIN}

const
  MNT_WAIT = 1;

// getmntinfo() is not thread-safe: we favor getfsstat() dual call
function getfsstat(statfs: pointer; bufsize: clong; mode: cint): cint;
  cdecl; external clib name 'getfsstat';

function GetDiskPartitions: TDiskPartitions;
var
  fs: ^TStatfs; // TStatfs may be redefined above for darwin aarch64
  max, n: PtrInt;
  t, m, f: RawUtf8; // FPC aarch64 requires explicit temp variables
  all: array of TStatFs;
begin
  result := nil;
  fs := nil;
  max := getfsstat(nil, 0, MNT_WAIT); // return the number to allocate
  if max <= 0 then
    exit;
  SetLength(all, max);
  fs := pointer(all);
  max := getfsstat(fs, max * SizeOf(all[0]), MNT_WAIT); // fill all[]
  if max <= 0 then
    exit;
  n := 0;
  repeat
    //WrDeb('fs^.mntfromname', fs^.mntfromname, SizeOf(fs^.mntfromname));
    //WrDeb('fs^.mountpoint', fs^.mountpoint, SizeOf(fs^.mountpoint));
    //WrDeb('fs^.fstypename',fs^.fstypename,SizeOf(fs^.fstypename));
    {$ifdef OSBSD} // the FPC RTL headers has field names issues
    FastSetString(t, @fs^.f_mntfromname, StrLen(@fs^.f_mntfromname));
    FastSetString(m, @fs^.f_mntonname,   StrLen(@fs^.f_mntonname));
    FastSetString(f, @fs^.f_fstypename,  StrLen(@fs^.f_fstypename));
    {$else}
    FastSetString(t, @fs^.mntfromname, StrLen(@fs^.mntfromname));
    FastSetString(m, @fs^.mountpoint,  StrLen(@fs^.mountpoint));
    FastSetString(f, @fs^.fstypename,  StrLen(@fs^.fstypename));
    {$endif OSBSD}
    AddDiskPartition(t, m, f, result, n);
    inc(fs);
    dec(max);
  until max = 0;
  SetLength(result, n);
end;

{$else}

function GetDiskPartitions: TDiskPartitions;
var
  mounts: RawUtf8;
  p: PUtf8Char;
  n: PtrInt;
begin
  // see https://github.com/gagern/gnulib/blob/master/lib/mountlist.c
  result := nil;
  mounts := StringFromFileNoSize('/proc/self/mounts');
  if mounts = '' then
    mounts := StringFromFileNoSize('/etc/mtab');
  p := pointer(mounts);
  if p = nil then // e.g. Darwin has no /etc/mtab :(
    exit;
  {$ifdef OSLINUXANDROID}
  if not (fProcFileSystemsTested in _F0) then
    LoadProcFileSystems; // read once from /proc/filesystems
  {$endif OSLINUXANDROID}
  n := 0;
  repeat
    AddDiskPartition(
      _GetNextSpaced(p), _GetNextSpaced(p), _GetNextSpaced(p), result, n);
    p := GotoNextLine(p);
  until p = nil;
  SetLength(result, n);
end;

{$endif OSBSDDARWIN}

{$ifdef OSBSDDARWIN}
  {$define USEMPROTECT}
{$else}
  {$ifdef OSANDROID}
    {$define USEMPROTECT}
  {$endif OSANDROID}
{$endif OSBSDDARWIN}

{$ifdef USEMPROTECT}
function mprotect(Addr: PtrUInt; Len: size_t; Prot: integer): integer;
  cdecl external clib name 'mprotect';
{$endif USEMPROTECT}

function SynMProtect(addr: PtrUInt; size: size_t; prot: integer): integer;
begin
  result := -1;
  {$ifdef UNIX}
    {$ifdef USEMPROTECT}
    result := mprotect(addr, size, prot);
    {$else}
    if Do_SysCall(syscall_nr_mprotect, TSysParam(addr), size, prot) >= 0 then
      result := 0;
    {$endif USEMPROTECT}
  {$endif UNIX}
end;

{$ifdef OSLINUX}
var
  Patched: TPtrUIntDynArray;
  PatchedCount: integer;

procedure PatchCodeProtectBack;
var
  i: PtrInt;
begin
  for i := 0 to PatchedCount - 1 do
    SynMProtect(Patched[i], SystemInfo.dwPageSize, PROT_READ or PROT_EXEC);
  PatchedCount := 0;
end;
{$else}
procedure PatchCodeProtectBack;
begin // nothing to do on Android/BSD/Darwin: not tested yet
end;
{$endif OSLINUX}

procedure PatchCode(Old, New: pointer; Size: PtrInt; Backup: pointer;
  LeaveUnprotected: boolean);
var
  OsPageSize, PageSize, AlignedAddr: PtrUInt;
  i: PtrInt;
  ProtectedResult, ProtectedMemory: boolean;
begin
  if Size <= 0 then
    exit;
  if Backup <> nil then
    for i := 0 to Size - 1 do // do not use Move() here
      PByteArray(Backup)^[i] := PByteArray(Old)^[i];
  OsPageSize := SystemInfo.dwPageSize;
  PageSize := OsPageSize;
  AlignedAddr := (PtrUInt(Old) div OsPageSize) * OsPageSize;
  while PtrUInt(Old) + PtrUInt(Size) >= AlignedAddr + PageSize do
    inc(PageSize, OsPageSize);
  {$ifdef OSLINUX}
  if LeaveUnprotected and
     (PageSize = OsPageSize) and
     PtrUIntScanExists(pointer(Patched), PatchedCount, AlignedAddr) then
  begin
    MoveByOne(New, Old, Size); // do not use Move() here
    exit;
  end;
  {$endif OSLINUX}
  ProtectedResult := SynMProtect(
    AlignedAddr, PageSize, PROT_READ or PROT_WRITE or PROT_EXEC) = 0;
  ProtectedMemory := not ProtectedResult;
  if ProtectedMemory then
    ProtectedResult := SynMProtect(
      AlignedAddr, PageSize, PROT_READ or PROT_WRITE) = 0;
  if ProtectedResult then
    try
      MoveByOne(New, Old, Size);// do not use Move() here
      if LeaveUnprotected then
        {$ifdef OSLINUX}
        AddPtrUInt(Patched, PatchedCount, AlignedAddr)
        {$endif OSLINUX}
      else if ProtectedMemory then
        SynMProtect(AlignedAddr, PageSize, PROT_READ or PROT_EXEC);
    except
      // we ignore any exception here - it should work anyway
    end;
end;

// on most platforms, Compute_FAKEVMT is run once with all JITted stubs
// on i386, it needs ArgsSizeInStack adjustement, but only 24 bytes per method
{$ifdef CPUARM}

var
  StubCallAllocMemLastStart: PtrUInt; // avoid unneeded fpmmap() calls
  StubCallFakeStubAddr: pointer;      // = ArmFakeStubAddr parameter

function StubCallAllocMem(const Size, flProtect: DWORD): pointer;
const
  STUB_RELJMP = {$ifdef CPUARM} $7fffff {$else} $7fffffff {$endif}; // rel jmp
  STUB_INTERV = STUB_RELJMP + 1; // try to reserve in closed stub interval
  STUB_ALIGN = QWord($ffffffffffff0000); // align to STUB_SIZE
var
  start, stop, stub, dist: PtrUInt;
begin
  stub := PtrUInt(StubCallFakeStubAddr); // = @TInterfacedObjectFake.ArmFakeStub
  if StubCallAllocMemLastStart <> 0 then
    start := StubCallAllocMemLastStart
  else
  begin
    start := stub - STUB_INTERV;
    if start > stub then
      start := 0; // avoid range overflow
    start := start and STUB_ALIGN;
  end;
  stop := stub + STUB_INTERV;
  if stop < stub then
    stop := high(PtrUInt);
  stop := stop and STUB_ALIGN;
  while start < stop do
  begin
    // try whole -STUB_INTERV..+STUB_INTERV range
    inc(start, STUB_SIZE);
    result := fpmmap(pointer(start), STUB_SIZE,
      flProtect, MAP_PRIVATE or MAP_ANONYMOUS, -1, 0);
    if result <> MAP_FAILED then
    begin
      // close enough for a 24/32-bit relative jump?
      dist := abs(stub - PtrUInt(result));
      if dist < STUB_RELJMP then
      begin
        StubCallAllocMemLastStart := start;
        exit;
      end
      else
        fpmunmap(result, STUB_SIZE);
    end;
  end;
  result := MAP_FAILED; // error
end;

{$else}

// other platforms (Intel+Arm64) use plain Kernel call and PtrInt jump
function StubCallAllocMem(const Size, flProtect: DWORD): pointer;
begin
  result := fpmmap(nil, STUB_SIZE,
    flProtect, MAP_PRIVATE OR MAP_ANONYMOUS, -1, 0);
end;

{$endif CPUARM}

function StubMemoryAlloc: pointer;
begin
  result := MAP_FAILED;
  if not (fStubMemoryExecXorWrite in _F1) then // W and X are exclusive on some OS
    result := StubCallAllocMem(STUB_SIZE, PROT_READ or PROT_WRITE or PROT_EXEC);
  if result = MAP_FAILED then
  begin
    // i.e. on OpenBSD or OSX aarch64, we can not have W and X protection
    result := StubCallAllocMem(STUB_SIZE, PROT_READ OR PROT_WRITE);
    if result <> MAP_FAILED then
      include(_F1, fStubMemoryExecXorWrite);
  end;
  if result = MAP_FAILED then
    result := nil;
end;

procedure StubMemoryFree(stub: pointer);
begin
  fpmunmap(stub, STUB_SIZE);
end;

procedure ReserveExecutableMemoryPageAccess(Reserved: pointer; Exec: boolean);
var
  aligned, pagesize: PtrUInt;
  flags: cardinal;
begin
  if not (fStubMemoryExecXorWrite in _F1) then
    // nothing to be done on this platform
    exit;
  // toggle execution permission of memory to be able to write into memory
  pagesize := SystemInfo.dwPageSize;
  aligned := (PtrUInt(Reserved) div pagesize) * pagesize;
  if Exec then
    flags := PROT_READ OR PROT_EXEC
  else
    flags := PROT_READ or PROT_WRITE;
  if SynMProtect(aligned, pagesize shl 1, flags) < 0 then
     raise EOSException.Create('ReserveExecutableMemoryPageAccess: mprotect fail');
end;


const
  // Transparent Huge Pages (THP) exist since Linux 2.6.38, Superpages provide
  // a similar benefit on FreeBSD, and macOS is less predictable but likely
  // to prefer such alignement
  // - so we ensure large blocks are always 2MB aligned on all POSIX systems
  // - note that Windows has no such automated mechanism, requires explicit
  // MEM_LARGE_PAGES flag and - even worse - enabling SeLockMemoryPrivilege
  PMD_SIZE = 2 shl 20;
  PMD_MASK = PMD_SIZE - 1; // aligned := (size + align - 1) AND NOT (align - 1)

{.$define OSLINUXHUGEPAGES}
// Huge Pages pool is void by default on most distros, and affects only mremap
// - so it is disabled but you may experiment using this conditional
// - in practice, THP is the preferred way and aligning to PMD_SIZE is enough

{$ifdef OSLINUXHUGEPAGES} // try Huge Page support on x86_64 and ARM64
const
  /// populate (prefault) pagetables to avoid page faults later - since 2.5.46
  // - even for large blocks, it may not be a good idea - not set
  MAP_POPULATE = $08000;

const
  /// explicit huge pages - with MAP_HUGE_2MB since Kernel 3.8
  MAP_HUGETLB    = $40000;
  MAP_HUGE_SHIFT = 26;
  MAP_HUGE_2MB   = 21 shl MAP_HUGE_SHIFT; // modifier combined with MAP_HUGETLB

var
  MAP_HUGE_SIZE: PtrUInt; // equals PMD_SIZE = 2MB since Kernel 3.8

function _GetLargeMem(BigSize: PtrUInt): pointer;
var
  flags: cardinal;
begin
  flags := MAP_PRIVATE or MAP_ANONYMOUS;
  if BigSize >= PMD_SIZE * 2 then
    BigSize := (BigSize + PMD_MASK) and not PMD_MASK;
  if (MAP_HUGE_SIZE <> 0) and
     (BigSize >= PMD_SIZE * 8) then
  begin
    flags := flags or MAP_HUGETLB or MAP_HUGE_2MB;
    result := fpmmap(nil, BigSize, PROT_READ or PROT_WRITE, flags, -1, 0);
    if result <> MAP_FAILED then
      exit;
    // on mmap() failure, /proc/sys/vm/nr_hugepages is likely to be 0
    // - check   "cat /proc/meminfo | grep HugePages_Free"
    // - and try "echo 1000 > /proc/sys/vm/nr_hugepages" as root
    // - but we did not see any noticeable benefit for this process
    MAP_HUGE_SIZE := 0; // disable this feature from now on
    flags := MAP_PRIVATE or MAP_ANONYMOUS;
  end;
  result := fpmmap(nil, BigSize, PROT_READ or PROT_WRITE, flags, -1, 0);
  if result = MAP_FAILED then
    result := nil; // as VirtualAlloc()
end;
{$else}
function _GetLargeMem(BigSize: PtrUInt): pointer;
begin
  if BigSize >= PMD_SIZE * 2 then  // ensure 2MB aligned for Size >= 4MB
    BigSize := (BigSize + PMD_MASK) and not PMD_MASK;
  result := fpmmap(nil, BigSize,
    PROT_READ or PROT_WRITE, MAP_PRIVATE or MAP_ANONYMOUS, -1, 0);
  if result = MAP_FAILED then
    result := nil; // as VirtualAlloc()
end;
{$endif OSLINUXHUGEPAGES}

procedure _FreeLargeMem(p: pointer; BigSize: PtrUInt);
begin
  if BigSize >= PMD_SIZE * 2 then
    BigSize := (BigSize + PMD_MASK) and not PMD_MASK; // as in mmap()
  fpmunmap(p, BigSize);
end;


{ ****************** Unix Daemon and Windows Service Support }

// Linux/POSIX signal interception

var
  SynDaemonInterceptLog: TSynLogProc;

procedure DoShutDown(Sig: integer; Info: PSigInfo; Context: PSigContext); cdecl;
var
  level: TSynLogLevel;
  si_code: integer;
  text: string[4]; // code below has no memory allocation
begin
  if Assigned(SynDaemonInterceptLog) then
  begin
    case Sig of
      SIGQUIT:
        text := 'QUIT';
      SIGTERM:
        text := 'TERM';
      SIGINT:
        text := 'INT';
      SIGABRT:
        text := 'ABRT';
    else
      text := 'SIG';
    end;
    level := sllExceptionOS; // abort after panic
    if Sig = SIGTERM then
      level := sllInfo;      // polite quit
    si_code := 0;
    if Info <> nil then
      try
        si_code := Info^.si_code;
      except
        si_code := -1; // paranoid
      end;
    SynDaemonInterceptLog(level,
      'SynDaemonIntercepted received SIG%=% si_code=%',
      [text, Sig, si_code], nil);
  end;
  SynDaemonTerminated := Sig;
end;

procedure SynDaemonIntercept(const onlog: TSynLogProc);
var
  sa: SigactionRec;
begin
  // note: SIGFPE/SIGSEGV/SIGBUS/SIGILL are handled by the RTL
  if fSynDaemonIntercepted in _F1 then
    exit;
  GlobalLock;
  try
    if fSynDaemonIntercepted in _F1 then
      exit;
    SynDaemonInterceptLog := onlog;
    FillCharFast(sa, SizeOf(sa), 0);
    sa.sa_flags := SA_SIGINFO; // sa_handler() 3-params signature
    sa.sa_handler := @DoShutDown;
    fpSigaction(SIGQUIT, @sa, nil);
    fpSigaction(SIGTERM, @sa, nil);
    fpSigaction(SIGINT,  @sa, nil);
    fpSigaction(SIGABRT, @sa, nil);
    include(_F1, fSynDaemonIntercepted); // set AFTER interception
  finally
    GlobalUnLock;
  end;
end;

// TO INVESTIGATE: we may use per-thread signal masking instead
// http://www.microhowto.info/howto/ignore_sigpipe_without_affecting_other_threads_in_a_process.html

procedure DoNothing(Sig: integer; Info: PSigInfo; Context: PSigContext); cdecl;
begin
end;

procedure SigPipeIntercept;
var
  sa: SigactionRec;
begin
  if fSigPipeDisabled in _F1 then
    exit; // quickly return if already done
  GlobalLock;
  try
    if fSigPipeDisabled in _F1 then
      exit;
    FillCharFast(sa, SizeOf(sa), 0);
    sa.sa_handler := @DoNothing;
    fpSigaction(SIGPIPE, @sa, nil);
    include(_F1, fSigPipeDisabled); // set AFTER disabling it
  finally
    GlobalUnLock;
  end;
end;

type
  TPasswd = record
    pw_name: PAnsiChar;    // user name
    pw_passwd: PAnsiChar;  // encrypted password
    pw_uid: TUid;	   // user uid
    pw_gid: TGid;	   // user gid
    // following fields are not consistent on BSD or Linux, but not needed
  end;
  PPasswd  = ^TPasswd;

// retrieve information of a given user by name
function getpwnam(name: PAnsiChar): PPasswd;
  cdecl external clib name 'getpwnam';

// sets the supplementary group IDs for the calling process
function setgroups(n: size_t; groups: PGid): integer;
  cdecl external clib name 'setgroups';

function setuid(uid: TUid): integer;
  cdecl external clib name 'setuid';
function setgid(gid: TGid): integer;
  cdecl external clib name 'setgid';

// changes the root directory of the calling process
function chroot(rootpath: PAnsiChar): integer;
  cdecl external clib name 'chroot';

function DropPriviledges(const UserName: RawUtf8): boolean;
var
  pwnam: PPasswd;
begin
  result := false;
  pwnam := getpwnam(pointer(UserName));
  if (pwnam = nil) or
     ((setgid(pwnam.pw_gid) <> 0) and
      (fpgeterrno <> ESysEPERM)) or
     ((setuid(pwnam.pw_uid) <> 0) and
      (fpgeterrno <> ESysEPERM)) then
    exit;
  result := true;
end;

function ChangeRoot(const FolderName: RawUtf8): boolean;
begin
  result := (FolderName <> '') and
            (FpChdir(pointer(FolderName)) = 0) and
            (chroot('.') = 0);
end;

function RunUntilSigTerminatedPidFile: TFileName;
var
  crc: cardinal;
begin
  result := RunUntilSigTerminatedPidFileName;
  if result <> '' then
    exit;
  // guess the folder to use for this daemon
  result := RunUntilSigTerminatedPidFilePath;
  if result = '' then
    if FileIsWritable(Executable.ProgramFilePath) then // fpaccess is enough
      result := Executable.ProgramFilePath
    else if FileIsWritable('/run') then
      result := '/run/' // favor tmpfs for transient file
    else
      result := GetSystemPath(spTemp)
  else
    result := IncludeTrailingPathDelimiter(result); // fixed user-supplied path
  // compute the geniune /run/.[ProgramName]-[ProgramFilePathHash].pid name
  crc := RunUntilSigTerminatedPidFileGenuine;
  if (crc = 0) and
     (result = Executable.ProgramFilePath) then // no [ProgramFilePathHash]
    result := Format('%s.%s.pid', [result, Executable.ProgramName])
  else
  begin
    if crc = 0 then // allow several executable instances in several folders
      crc := crc32cHash(Executable.ProgramFilePath);
    result := Format('%s.%s%x.pid', [result, Executable.ProgramName, crc]);
  end;
  RunUntilSigTerminatedPidFileName := result;
end;

function RunUntilSigTerminatedState: TServiceState;
begin
  if FileExists(RunUntilSigTerminatedPidFile) then
    result := ssRunning
  else
    result := ssStopped;
end;

function RunUntilSigTerminatedForKill(waitseconds: integer): boolean;
var
  pid, pidnew: PtrInt;
  pidfile: TFileName;
  tix: Int64;
begin
  result := false;
  pidfile := RunUntilSigTerminatedPidFile;
  pid := GetInteger(pointer(StringFromFile(pidfile)));
  if (pid <= 0) or
     (pid = PtrInt(FpGetpid)) then
    exit;
  {$ifdef OSLINUX} // BSD does not implement this (yet)
  if IsNotCurrentExeDaemonized(pid) then
    result := DeleteFile(pidfile) // this daemon does not exist any more
  else
  {$endif OSLINUX}
  if fpkill(pid, SIGTERM) <> 0 then  // polite/weak quit failed
  begin
    if fpgeterrno = ESysESRCH then   // ESysESRCH = no such process
      result := DeleteFile(pidfile); // crashed and not restarted -> clean
  end
  else if waitseconds <= 0 then
    result := true // TERM sent and no wait needed
  else
  begin
    tix := GetTickCount64 + waitseconds * MilliSecsPerSec; // need ms resolution
    repeat
      // RunUntilSigTerminated() below should eventually delete the .pid file
      SleepHiRes(10);
      pidnew := GetInteger(pointer(StringFromFile(pidfile)));
      result := (pidnew = 0) or (pidnew <> pid); // stopped or restarted
      if result then
        exit;
    until GetTickCount64 > tix;
    // timeout: murder with finesse
    if {$ifdef OSLINUX}
       IsNotCurrentExeDaemonized(pid) or
       {$endif OSLINUX}
       ((fpkill(pid, SIGKILL) <> 0) and
        (fpgeterrno = ESysESRCH)) then
      DeleteFile(pidfile); // process crashed and not reboot -> clean
  end;
end;

procedure CleanAfterFork;
begin
  fpUMask(0); // reset file mask
  chdir('/'); // avoid locking current directory
  Close(input);
  AssignFile(input, '/dev/null');
  ReWrite(input);
  Close(output);
  AssignFile(output, '/dev/null');
  ReWrite(output);
  Close(stderr);
end;

procedure RunUntilSigTerminated(daemon: TObject; dofork: boolean;
  const start, stop: TThreadMethod; const onlog: TSynLogProc;
  const servicename: string);
var
  pid, sid: TPID;
  pidfilename: TFileName;
  s: AnsiString;
const
  TXT: array[boolean] of string[4] = ('run', 'fork');
begin
  SynDaemonIntercept(onlog);
  if dofork then
  begin
    pidfilename := RunUntilSigTerminatedPidFile;
    pid := GetInteger(pointer(StringFromFile(pidfilename)));
    if pid > 0 then
      if (fpkill(pid, 0) = 0) or
         not DeleteFile(pidfilename) then
        EOSException.RaiseFmt(daemon,
          'CommandLine Fork failed: %s is already forked as pid=%d',
          [Executable.ProgramName, PtrInt(pid)]);
    pid := fpFork;
    if pid < 0 then
      EOSException.RaiseFmt(daemon, 'CommandLine Fork failed', []);
    if pid > 0 then  // main program - just terminate
      exit;
    // clean forked instance
    sid := fpSetSID;
    if sid < 0 then // new session (process group) created?
      EOSException.RaiseFmt(daemon, 'CommandLine SetSID failed', []);
    CleanAfterFork;
    // create local .[Executable.ProgramName].pid file
    pid := fpgetpid;
    str(pid, s);
    FileFromString(s, pidfilename);
  end;
  try
    if Assigned(onlog) then
      onlog(sllNewRun, 'Start % /% %',
        [servicename, TXT[dofork], Executable.Version.DetailedOrVoid], nil);
    Start;
    while SynDaemonTerminated = 0 do
      if GetCurrentThreadID = MainThreadID then
        CheckSynchronize(100)
      else
        SleepHiRes(100);
  finally
    if Assigned(onlog) then
      onlog(sllNewRun, 'Stop /% from Sig=%',
        [TXT[dofork], SynDaemonTerminated], nil);
    try
      Stop;
    finally
      if dofork and
         (pidfilename <> '') then
      begin
        DeleteFile(pidfilename);
        if Assigned(onlog) then
          onlog(sllTrace, 'RunUntilSigTerminated: deleted file %',
            [pidfilename], nil);
      end;
    end;
  end;
end;

function RunInternal(args: PPAnsiChar; waitfor: boolean; const env: TFileName;
  options: TRunOptions): integer;
var
  pid: TPID;
  e: array[0..511] of PAnsiChar; // max 512 environment variables
  envpp: PPAnsiChar;
  P: PAnsiChar;
  n: PtrInt;
begin
  {$ifdef FPC}
  {$if (defined(BSD) or defined(SUNOS)) and defined(FPC_USE_LIBC)}
  pid := FpvFork;
  {$else}
  pid := FpFork;
  {$ifend}
  {$else}
  'only FPC is supported yet';
  {$endif FPC}
  if pid < 0 then
  begin
    // fork failed
    result := -1;
    exit;
  end;
  if pid = 0 then
  begin
    // we are in child process -> switch to new executable
    if not waitfor then
      // don't share the same console
      CleanAfterFork;
    envpp := envp;
    if env <> '' then
    begin
      n := 0;
      result := -ESysE2BIG;
      if (roEnvAddExisting in options) and
         (envpp <> nil) then
      begin
        while envpp^ <> nil do
        begin
          if PosChar(envpp^, #10) = nil then
          begin
            // filter to add only single-line variables
            if n = high(e) - 1 then
              exit;
            e[n] := envpp^;
            inc(n);
          end;
          inc(envpp);
        end;
      end;
      P := pointer(env); // env follows Windows layout 'n1=v1'#0'n2=v2'#0#0
      while P^ <> #0 do
      begin
        if n = high(e) - 1 then
          exit;
        e[n] := P; // makes POSIX compatible
        inc(n);
        inc(P, StrLen(P) + 1);
      end;
      e[n] := nil; // end with null
      envpp := @e;
    end;
    FpExecve(args^, args, envpp);
    FpExit(127);
  end;
  if waitfor then
  begin
    result := WaitProcess(pid);
    if result = 127 then
      // execv() failed in child process
      result := -result;
  end
  else
    // fork success (don't wait for the child process to fail)
    result := 0;
end;

function RunProcess(const path, arg1: TFileName; waitfor: boolean;
  const arg2, arg3, arg4, arg5, env: TFileName;
  options: TRunOptions): integer;
var
  a: array[0..6] of PAnsiChar; // assume no UNICODE on POSIX, i.e. as TFileName
begin
  a[0] := pointer(path);
  a[1] := pointer(arg1);
  a[2] := pointer(arg2);
  a[3] := pointer(arg3);
  a[4] := pointer(arg4);
  a[5] := pointer(arg5);
  a[6] := nil; // end pointer list with null
  result := RunInternal(@a, waitfor, env, options);
end;

function RunCommand(const cmd: TFileName; waitfor: boolean;
  const env: TFileName; options: TRunOptions; parsed: PParseCommands): integer;
var
  temp: RawUtf8;
  err: TParseCommands;
  a: TParseCommandsArgs;
begin
  err := ParseCommandArgs(cmd, @a, nil, @temp);
  if parsed <> nil then
    parsed^ := err;
  if err = [] then
    // no need to spawn the shell for simple commands
    result := RunInternal(a, waitfor, env, options)
  else if err * PARSECOMMAND_ERROR <> [] then
    // no system call for clearly invalid command line
    result := -ESysEPERM
  else
  begin
    // execute complex commands via the shell
    a[0] := '/bin/sh';
    a[1] := '-c';
    a[2] := pointer(cmd);
    a[3] := nil;
    result := RunInternal(@a, waitfor, env, options);
  end;
end;

function RunRedirect(const cmd: TFileName; exitcode: PInteger;
  const onoutput: TOnRedirect; waitfordelayms: cardinal;
  setresult: boolean; const env, wrkdir: TFileName; options: TRunOptions): RawByteString;
var
  // notes: - FPC popen() allows access to the pid whereas clib popen() won't
  //        - env and options params are not supported by popen() so are ignored
  f: file;
  fd: THandle;
  pid, res, wr: cint;
  n: TSsize;
  wait: cardinal;
  endtix: Int64;
  tmp: TBuffer64K;

  function RedirectOutput(killing: boolean; var redir: RawByteString): boolean;
  var
    u: RawUtf8;
  begin
    result := false; // return false on pipe closed
    if WaitReadPending(fd, wait) then
    begin
      n := fpread(fd, tmp, SizeOf(tmp));
      if n < 0 then
        exit; // pipe closed or EINTR = execution finished
      if setresult and
         (n <> 0) then
        AppendBufferToUtf8(@tmp, n, RawUtf8(redir)); // assume CP_UTF8
      if Assigned(onoutput) then
      begin
        FastSetString(u, @tmp, n); // console output is likely UTF-8 on POSIX
        if onoutput(u, pid) and
           not killing then
          endtix := 1; // returned true: force kill() on abort
      end;
    end
    else if Assigned(onoutput) and // idle
            onoutput('', pid) and
            not killing then
      endtix := 1; // returned true to abort -> kill()
    result := true;
  end;

begin
  result := '';
  if wrkdir <> '' then
    ChDir(wrkdir);
  if popen(f, cmd, 'r') <> 0 then // fork and launch cmd - env is ignored by now
    exit;
  fd := TFileRec(f).Handle;
  pid := pcint(@TFileRec(f).userdata[2])^; // see popen() from Unix.pp
  if Assigned(onoutput) then
    onoutput('', pid);
  wait := 200;
  endtix := 0;
  if waitfordelayms <> INFINITE then
  begin
    if waitfordelayms < wait then
      wait := waitfordelayms;
    endtix := GetTickCount64 + waitfordelayms;
  end;
  repeat
    if not RedirectOutput({killing=}false, result) then
      break; // pipe closed = execution finished
    if (endtix <> 0) and
       (GetTickCount64 > endtix) then
    begin
      // abort process execution after timeout or onoutput()=true
      if RunAbortTimeoutSecs > 0 then
      begin
        // try gracefull death
        if (ramSigTerm in RunAbortMethods) and
           (fpkill(pid, SIGTERM) = 0) then
        begin
          endtix := GetTickCount64 + RunAbortTimeoutSecs * 1000;
          repeat
            wr := FpWaitPid(pid, @res, WNOHANG);    // 0 = no state change
            RedirectOutput({killing=}true, result); // continue redirection
            if (wr <> 0) or
               (GetTickCount64 > endtix) then
              break;
            SleepHiRes(5);
          until false;
          if wr = pid then // <0 for error
            break; // gracefully ended
        end;
      end;
      // force process termination alla Roberspierre
      fpkill(pid, SIGKILL);
      pid := 0;
      break;
    end;
  until false;
  res := pclose(f);
  if exitcode <> nil then
    if pid = 0 then
      exitcode^ := -1
    else
      exitcode^ := res;
end;


{ ****************** Gather Operating System Information }

{$ifdef OSANDROID}

function GetSmbEfiMem: RawByteString;
begin
  result := '';
end;

{$ifdef CPUARM}
const getpagesize = 4096; // ARM32 does not seem to have getpagesize in clib :(
{$else}
// we used to hardcode this to 4096 on Android, but Android 15 uses 16KB
function getpagesize: integer; cdecl external clib name 'getpagesize';
{$endif CPUARM}

{$else}
function getpagesize: integer;
  cdecl external clib name 'getpagesize';
{$endif OSANDROID}

{$ifdef OSLINUX}

function get_nprocs: integer;
  cdecl external clib name 'get_nprocs';

procedure SetLinuxDistrib(const release: RawUtf8);
var
  distrib: TOperatingSystem;
  rel, dist: RawUtf8;
begin
  rel := UpperCase(release);
  for distrib := osArch to high(distrib) do
  begin
    dist := UpperCase(OS_NAME[distrib]);
    if PosEx(dist, rel) > 0 then
    begin
      OS_KIND := distrib;
      break;
    end;
  end;
end;

function clock_gettime_c(clk_id: clockid_t; tp: ptimespec): cint;
begin
  // FPC only knows the regular clocks: convert to the *_FAST version
  case clk_id of
    // 1 ms resolution is good enough for milliseconds-based RTL functions
    CLOCK_REALTIME:
      clk_id := CLOCK_REALTIME_FAST;
    CLOCK_MONOTONIC:
      clk_id := CLOCK_MONOTONIC_FAST;
    // no CLOCK_MONOTONIC_RAW redirect because it doesn't match CLOCK_MONOTONIC
    // and cthreads.pp forces pthread_condattr_setclock(CLOCK_MONOTONIC_RAW)
  end;
  // it is much faster to not use the Linux syscall but the libc vDSO call
  result := clock_gettime(clk_id, tp);
end;

function gettimeofday_c(tp: ptimeval; tzp: ptimezone): cint;
begin
  // it is much faster to not use the Linux syscall but the libc vDSO call
  result := gettimeofday(tp, tzp);
end;

function GetSmbEfiMem: RawByteString;
var
  efi, addr: RawUtf8;
  xaddr: cardinal;
begin
  // retrieve raw EFI information from systab
  result := '';
  xaddr := 0;
  efi := StringFromFileNoSize('/sys/firmware/efi/systab');
  if efi = '' then
    efi := StringFromFileNoSize('/proc/efi/systab'); // old Linux<2.6.6
  if efi = '' then
    exit;
  FindNameValue(pointer(efi), 'SMBIOS', addr);
  xaddr := ParseHex0x(pointer(addr));
  if xaddr <> 0 then
    result := ReadSystemMemory(xaddr, 32); // 32 bytes is enough
end;

// on Android, /sys/class/net is not readable from the standard user :(
function _GetSystemMacAddress: TRawUtf8DynArray;
var
  SR: TSearchRec;
  fn: ShortString;
  fnl: AnsiChar;
  f: RawUtf8;
begin
  result := nil;
  if FindFirst('/sys/class/net/*', faDirectory, SR) <> 0 then
    exit;
  repeat
    if (SR.Name <> 'lo') and
       not IdemPChar(pointer(SR.Name), 'DOCKER') and
       SearchRecValidFolder(SR) then
    begin
      fn := '/sys/class/net/';
      AppendShortAnsi7String(SR.Name, fn);
      fnl := fn[0];
      AppendShort('/flags'#0, fn);
      LoadProcFileTrimed(@fn[1], f);
      if (length(f) > 2) and // e.g. '0x40' or '0x1043'
         (ParseHex0x(pointer(f)) and {IFF_LOOPBACK:}8 = 0) then
      begin
        fn[0] := fnl;
        AppendShort('/address'#0, fn);
        LoadProcFileTrimed(@fn[1], f);
        if f <> '' then
          _AddRawUtf8(result, f);
      end;
    end;
  until FindNext(SR) <> 0;
  FindClose(SR);
end;

{$endif OSLINUX}

{$ifdef OSLINUXANDROID}

var
  __BiosInfoText: RawUtf8;
  __BiosInfoHardwareFromCpuInfo: RawUtf8;

procedure TrimDualSpaces(var s: RawUtf8); forward;

procedure SetBiosInfoText(var txt: RawUtf8);
{$ifdef OSLINUX}
var
  prod: RawUtf8;
{$endif OSLINUX}
begin
  {$ifdef OSLINUX}
  txt := TrimU(Join([LoadProcFileTrim('/sys/class/dmi/id/sys_vendor'), ' ',
                     LoadProcFileTrim('/sys/class/dmi/id/product_name')]));
  if txt <> '' then
  begin // e.g. 'QEMU KVM Virtual Machine' or 'LENOVO 20HES23B0U'
    LoadProcFileTrimed('/sys/class/dmi/id/product_version', prod);
    if prod <> '' then
      txt := Join([txt, ' ', prod]);
  end
  else
    // return e.g. 'Raspberry Pi 3 Model B Rev 1.2'
    LoadProcFileTrimed('/proc/device-tree/model', txt);
  {$else} // get this information the Android way
  txt := TrimU(Join([GetSystemProperty('ro.product.brand'), ' ',
                     GetSystemProperty('ro.product.name'), ' ',
                     GetSystemProperty('ro.product.device')]));
  {$endif OSLINUX}
  if __BiosInfoHardwareFromCpuInfo <> '' then // e.g. 'Hardware : BCM2709' on RPi3
    if txt = '' then
      txt := __BiosInfoHardwareFromCpuInfo
    else
      txt := Join([txt, ' (', __BiosInfoHardwareFromCpuInfo, ')'])
  else if txt = '' then
    {$ifdef CPUARM3264}
    if CpuArmModel <> '' then
      Join(['Unamed ', CpuArmModel, ' system'], txt)
    else
    {$endif CPUARM3264}
      txt := 'Generic ' + CPU_ARCH_TEXT + ' system';
  TrimDualSpaces(txt);
end;

function BiosInfoText: RawUtf8;
begin
  if __BiosInfoText = '' then
    SetBiosInfoText(__BiosInfoText);
  result := __BiosInfoText;
end;

{$endif OSLINUXANDROID}

{$ifdef CPUARM3264} // POSIX libc is faster than FPC RTL or our pascal code

function libc_strlen(s: PAnsiChar): SizeInt;
  cdecl external clib name 'strlen';

function libc_memmove(dst, src: pointer; n: SizeInt): pointer;
  cdecl external clib name 'memmove';

function libc_memset(dst: pointer; c: integer; n: SizeInt): pointer;
  cdecl external clib name 'memset';

function StrLenLibc(s: PAnsiChar): SizeInt;
begin
  if s = nil then
    result := PtrUInt(s)
  else
    result := libc_strlen(s);
end;

procedure MoveFastLibC(const source; var dest; count: SizeInt);
begin
  if (@dest <> @source) and
     (count > 0) then
    libc_memmove(@dest, @source, count);
end;

procedure FillCharLibC(var dest; count: PtrInt; value: byte);
begin
  if (@dest <> nil) and
     (count > 0) then
    libc_memset(@dest, value, count);
end;

{$ifdef OSLINUXANDROID}

procedure RetrieveCpuInfoArm;
begin
  if CpuFeatures = [] then
  begin
    // fallback to /proc/cpuinfo "Features:" text
    if PosEx(' aes', CpuInfoFeatures) >= 0 then
      include(CpuFeatures, ahcAes);
    if PosEx(' pmull', CpuInfoFeatures) >= 0 then
      include(CpuFeatures, ahcPmull);
    if PosEx(' sha1', CpuInfoFeatures) >= 0 then
      include(CpuFeatures, ahcSha1);
    if PosEx(' sha2', CpuInfoFeatures) >= 0 then
      include(CpuFeatures, ahcSha2);
    if PosEx(' crc32', CpuInfoFeatures) >= 0 then
      include(CpuFeatures, ahcCrc32);
  end;
end;

{$endif OSLINUXANDROID}

{$endif CPUARM3264}

{$undef ARMV8STATIC}
{$ifdef CPUAARCH64}
{$ifdef OSLINUXANDROID}
// AARCH64 armv8.o is only validated on Linux
// (it should work on other POSIX ABI, but was reported to fail)

{$define ARMV8STATIC}
{$L ..\..\static\aarch64-linux\armv8.o} // ARMv8 crc32c Linux code

function crc32carm64(crc: cardinal; buf: PAnsiChar; len: cardinal): cardinal; external;
function crc32arm64(crc: cardinal; buf: PAnsiChar; len: cardinal): cardinal; external;
function crc32cby4arm64(crc, value: cardinal): cardinal; external;
procedure crc32blockarm64(crc128, data128: PBlock128); external;
procedure crc32blocksarm64(crc128, data128: PBlock128; count: integer); external;

{$endif OSLINUXANDROID}
{$endif CPUAARCH64}

procedure InitializeSpecificUnit;
var
  P: PAnsiChar;
  modname, beg: PUtf8Char;
  uts: UtsName;
  {$ifndef NODIRECTTHREADMANAGER}
  tm: TThreadManager;
  {$endif NODIRECTTHREADMANAGER}
  {$ifndef OSDARWIN}
  {$ifdef CPUARM3264}
  act, aci: TIntegerDynArray;
  i: PtrInt;
  {$endif CPUARM3264}
  tpfail: integer;
  tp: array[0 .. 1{$ifdef OSLINUX} + 2{$endif}] of timespec;
  {$endif OSDARWIN}
  {$ifdef OSBSDDARWIN}
  temp1, temp2: ShortString;
  {$else}
  cache, cpuinfo: PUtf8Char;
  release: RawUtf8;
  procid, phyid, phyndx: integer;
  phy: TIntegerDynArray;
  auxv: PPtrUInt;
  {$ifdef OSLINUX}
  dist: RawUtf8;
  SR: TSearchRec;
  si: TSysInfo;  // Linuxism
  {$endif OSLINUX}
  {$endif OSBSDDARWIN}
begin
  // some ARM/AARCH64 specific initialization
  {$ifdef CPUARM3264}
  StrLen := @StrLenLibc; // libc version is faster than plain pascal or RTL code
  MoveFast := @MoveFastLibC;
  FillCharFast := @FillCharLibC;
  {$ifdef ARMV8STATIC}
  if ahcCrc32 in CpuFeatures then
    try
      if (crc32cby4arm64(0, 1) = 3712330424) and
         (crc32carm64(0, @uts, SizeOf(uts)) = crc32cfast(0, @uts, SizeOf(uts))) then
      begin
        crc32c          := @crc32carm64;
        DefaultHasher   := @crc32carm64;
        InterningHasher := @crc32carm64;
        crc32cby4       := @crc32cby4arm64;
        crcblock        := @crc32blockarm64;
        crcblocks       := @crc32blocksarm64;
      end;
      if crc32arm64(0, @uts, SizeOf(uts)) = crc32fast(0, @uts, SizeOf(uts)) then
        crc32 := @crc32arm64;
    except
      exclude(CpuFeatures, ahcCrc32); // crc32 was actually not supported
    end;
  {$endif ARMV8STATIC}
  {$endif CPUARM3264}
  // retrieve Kernel and Hardware information
  StdOut := StdOutputHandle;
  modname := nil;
  {$ifdef OSBSDDARWIN}
  // pure FreeBSD NetBSD MacOS branch
  SystemInfo.dwNumberOfProcessors := fpsysctlhwint(HW_NCPU);
  beg := fpsysctlhwstr(HW_MACHINE, temp1);
  {$ifdef OSDARWIN}
  if strscan(beg, ' ') = nil then // e.g. from a Parallels VM
    beg := fpsysctlhwstr(HW_MODEL, temp1);
  modname := fpsysctlbynamestr('machdep.cpu.brand_string', temp2);
  {$endif OSDARWIN}
  FastSetString(BiosInfoText, beg, StrLen(beg));
  if modname = nil then
    modname := fpsysctlhwstr(HW_MODEL, temp2);
  {$ifdef OSDARWIN}
  // pure MACOS branch
  CpuCache[1].LineSize := fpsysctlhwint(HW_CACHELINE);
  CpuCache[1].Size     := fpsysctlhwint(HW_L1DCACHESIZE);
  CpuCache[2].LineSize := fpsysctlhwint(HW_CACHELINE);
  CpuCache[2].Size     := fpsysctlhwint(HW_L2CACHESIZE);
  CpuCache[3].LineSize := fpsysctlhwint(HW_CACHELINE);
  CpuCache[3].Size     := fpsysctlhwint(HW_L3CACHESIZE);
  CpuCacheSize := CpuCache[3].Size;
  if CpuCacheSize = 0 then
    CpuCacheSize := CpuCache[2].Size;
  if CpuCacheSize = 0 then
    CpuCacheSize := CpuCache[1].Size;
  if CpuCacheSize <> 0 then
    _fmt('L1=%s L2=%s L3=%s', [KBNoSpace(CpuCache[1].Size),
      KBNoSpace(CpuCache[2].Size), KBNoSpace(CpuCache[3].Size)], CpuCacheText);
  SystemMemorySize := fpsysctlhwint(HW_MEMSIZE);
  {$else}
  SystemMemorySize := fpsysctlhwint(HW_PHYSMEM);
  {$endif OSDARWIN}
  {$else}
  {$ifdef OSANDROID}
  // pure ANDROID branch
  release := GetSystemProperty('ro.build.version.release');
  {$else}
  // pure LINUX branch
  GetSystemMacAddress := _GetSystemMacAddress;
  if Sysinfo(@si) = 0 then // uptime + loadavg + meminfo + numprocess
    SystemMemorySize := si.totalram * si.mem_unit;
  crc32c128(@SystemEntropy.Startup, @si, SizeOf(si));
  // https://www.freedesktop.org/software/systemd/man/latest/os-release.html
  FindFileValue('/etc/os-release', 'PRETTY_NAME=', release); // new "standard"
  if release = '' then // oldest Linux Standard Base location
    FindFileValue('/etc/lsb-release', 'DISTRIB_DESCRIPTION=', release);
  if (release <> '') and
     (release[1] = '"') then
    release := copy(release, 2, length(release) - 2);
  TrimSelf(release);
  if (release = '') and
     (FindFirst('/etc/*-release', faAnyFile, SR) = 0) then // fast enough
  begin // http://linuxmafia.com/faq/Admin/release-files.html
    release := SR.Name; // 'redhat-release' 'SuSE-release'
    if IdemPChar(pointer(release), 'LSB-') and // /etc/lsb-release done above
       (FindNext(SR) = 0) then
      release := SR.Name;
    release := Split(release, '-');
    dist := Split(StringFromFileNoSize(Join(['/etc/', SR.Name])), #10);
    if (dist <> '') and
       (PosExChar('=', dist) = 0) and
       (PosExChar(' ', dist) > 0) then
      // e.g. dist='Red Hat Enterprise Linux Server release 6.7 (Santiago)'
      SetLinuxDistrib(dist)
    else
      dist := '';
    FindClose(SR);
  end;
  if (release <> '') and
     (OS_KIND = osLinux) then
  begin
    SetLinuxDistrib(release);
    if (OS_KIND = osLinux) and
       ({%H-}dist <> '') then
    begin
      SetLinuxDistrib(dist);
      release := dist;
    end;
    if OS_KIND = osLinux then
      if (PosEx('RH', release) > 0) or
         (PosEx('Red Hat', release) > 0) then
        OS_KIND := osRedHat
      else if (FpAccess('/usr/bin/apt', F_OK) = 0) or
              (FpAccess('/usr/bin/apt-get', F_OK) = 0) then
        OS_KIND := osApt  // seems Debian-based
      else if FpAccess('/usr/bin/rpm', F_OK) = 0 then
        OS_KIND := osRpm; // seems RPM-based
  end;
  {$endif OSANDROID}
  OS_DISTRI := LinuxDistribution(OS_KIND);
  cache := nil;
  SystemInfo.dwNumberOfProcessors := 0;
  CpuInfoLinux := StringFromFileNoSize('/proc/cpuinfo'); // too big for LoadProcFile
  crc32c128(@SystemEntropy.Startup, pointer(CpuInfoLinux), length(CpuInfoLinux));
  procid := -1;
  cpuinfo := pointer(CpuInfoLinux);
  while cpuinfo <> nil do
  begin
    beg := cpuinfo;
    cpuinfo := GotoNextLine(cpuinfo);
    if IdemPChar(beg, 'PROCESSOR') then
      if beg^ = 'P' then
        modname := ParseLine(beg) // Processor : ARMv7
      else
      begin
        // loop over all "processor : 0 .. 1 .. 2" lines to count the CPUs
        inc(SystemInfo.dwNumberOfProcessors);
        procid := ParseInt(beg);
        if procid >= integer(SystemInfo.dwNumberOfProcessors) then
          procid := -1; // paranoid
      end
    else if IdemPChar(beg, 'MODEL') then
      modname := ParseLine(beg)
    else if IdemPChar(beg, 'FEATURES') or
            IdemPChar(beg, 'FLAGS') then
      CpuInfoFeatures := ParseLine(beg)
    else if IdemPChar(beg, 'HARDWARE') then
      __BiosInfoHardwareFromCpuInfo := ParseLine(beg)
    else if IdemPChar(beg, 'SERIAL') then
      _Smbios[sbiSerial] := LowerCase(TrimU(ParseLine(beg)))
    else if IdemPChar(beg, 'CACHE SIZE') then
      cache := ParseLine(beg)
    {$ifdef CPUARM3264}
    else if IdemPChar(beg, 'CPU IMPLEMENTER') then
      ParseHex32Add(beg, aci)
    else if IdemPChar(beg, 'CPU PART') then
      ParseHex32Add(beg, act)
    {$endif CPUARM3264}
    else if IdemPChar(beg, 'PHYSICAL ID') then
    begin
      phyid := ParseInt(beg); // in practice, may be 0,3,... and not 0,1,...
      if phyid < 0 then
        continue;
      phyndx := IntegerScanIndex(pointer(phy), CpuSockets, phyid);
      if phyndx < 0 then
      begin
        AddInteger(phy, CpuSockets, phyid);
        SetLength(CpuSocketsMask, CpuSockets);
        phyndx := CpuSockets - 1;
      end;
      if (procid >= 0) and
         (procid < SizeOf(TCpuSet) shl 3) then
        SetBitPtr(@CpuSocketsMask[phyndx], procid);
    end;
  end;
  {$ifdef CPUARM3264}
  if act <> nil then // CPU part/implementer are more detailed than model name
  begin
    for i := 0 to high(aci) do // there should be a single implementer
      AppendShortToUtf8(ArmCpuImplementerName(
        ArmCpuImplementer(aci[i]), aci[i], ' '), CpuArmModel);
    AppendShortToUtf8(ArmCpuTypeName(ArmCpuType(act[0]), act[0]), CpuArmModel);
    for i := 1 to high(act) do // but there may be several parts/models
      AppendShortToUtf8(ArmCpuTypeName(ArmCpuType(act[i]),
        act[i], ' / '), CpuArmModel);
    modname := pointer(CpuArmModel);
  end;
  RetrieveCpuInfoArm;
  {$endif CPUARM3264}
  if cache <> nil then
  begin
    CpuCacheText := TrimU(cache);
    CpuCacheSize := _GetNextCardinal(cache);
    while cache^ = ' ' do
      inc(cache);
    case upcase(cache^) of
      'K':
        CpuCacheSize := CpuCacheSize shl 10;
      'M':
        CpuCacheSize := CpuCacheSize shl 20;
      'G':
        CpuCacheSize := CpuCacheSize shl 30;
    end;
  end;
  SystemInfo.release := release;
  {$endif OSBSDDARWIN}
  SystemInfo.dwPageSize := getpagesize; // call libc API
  if CpuCacheSize <> 0 then
    _fmt('[%s]', [KBNoSpace(CpuCacheSize)], CpuInfoText);
  if CpuSockets = 0 then
    CpuSockets := 1;
  if fpuname(uts) < 0 then
    FillChar(uts, SizeOf(uts), 0);
  crc32c128(@SystemEntropy.Startup, @uts, SizeOf(uts));
  SystemInfo.uts.release  := uts.Release;
  SystemInfo.uts.sysname  := uts.SysName;
  SystemInfo.uts.version  := uts.Version;
  SystemInfo.uts.nodename := uts.NodeName;
  OSVersionText := Join([SystemInfo.uts.sysname, ' ', SystemInfo.uts.release]);
  if SystemInfo.release <> '' then
    OSVersionText := Join([SystemInfo.release, ' - ', OSVersionText]);
  P := @uts.release[0];
  KernelRevision := _GetNextCardinal(P) shl 16 +
                    _GetNextCardinal(P) shl 8 +
                    _GetNextCardinal(P); // 24-bit big endian for easy compare
  OSVersion32.os := OS_KIND;
  MoveByOne(@KernelRevision, @OSVersion32.utsrelease, 3); // 24-bit
  {$ifdef OSANDROID}
  OSVersionText := Join(['Android (', OSVersionText, ')']);
  {$else}
  {$ifdef OSLINUX}
  if SystemInfo.dwNumberOfProcessors = 0 then // e.g. QEMU limited /proc/cpuinfo
    SystemInfo.dwNumberOfProcessors := get_nprocs;
  {$endif OSLINUX}
  {$endif OSANDROID}
  if SystemInfo.dwNumberOfProcessors = 0 then
    SystemInfo.dwNumberOfProcessors := 1;
  if modname = nil then
    CpuInfoText := _fmt('%d x generic ' + CPU_ARCH_TEXT + ' cpu %s',
      [SystemInfo.dwNumberOfProcessors, CpuInfoText])
  else
    CpuInfoText := _fmt('%d x %s %s (' + CPU_ARCH_TEXT + ')',
      [SystemInfo.dwNumberOfProcessors, modname, CpuInfoText]);
  // initialize supported APIs
  TimeZoneLocalBias := -GetLocalTimeOffset;
  _Fill256FromOs    := @__Fill256FromOs;
  {$ifdef OSLINUX}
  {$ifdef OSLINUXHUGEPAGES}
  if KernelRevision >= $030800 then // since Kernel 3.8
    MAP_HUGE_SIZE := PMD_SIZE; // explicit huge pages for _GetLargeMem()
  {$endif OSLINUXHUGEPAGES}
  {$ifdef HASGETRANDOM}
  if KernelRevision < $031100 then // since Kernel 3.17
    include(_F0, fLinuxGetRandomFailed);
  {$endif HASGETRANDOM}
  {$ifdef HASEVENTFD}
  if KernelRevision < $02061b then // since Kernel 2.6.27
    include(_F0, fLinuxEventFdFailed);
  {$endif HASEVENTFD}
  {$endif OSLINUX}
  // for inlined RTL calls (avoid one level of redirection)
  {$ifndef NODIRECTTHREADMANAGER}
  GetThreadManager(tm);
  @GetCurrentThreadId      := @tm.GetCurrentThreadId;
  @TryEnterCriticalSection := @tm.TryEnterCriticalSection;
  @EnterCriticalSection    := @tm.EnterCriticalSection;
  @LeaveCriticalSection    := @tm.LeaveCriticalSection;
  {$endif NODIRECTTHREADMANAGER}
  {$ifdef OSDARWIN}
  OSVersionText := Join([ToTextU(OSVersion32), ' (', OSVersionText, ')']);
  mach_timebase_info(mach_timeinfo);
  mach_timecoeff := mach_timeinfo.Numer / mach_timeinfo.Denom;
  if (mach_timeinfo.Numer = 1) and
     (mach_timeinfo.Denom = 1) then
    include(_F1, fMachTimeNanoSec);
  PInt64Array(@uts)[0] := mach_absolute_time;
  PInt64Array(@uts)[1] := PInt64(@mach_timecoeff)^;
  crcblock(@SystemEntropy.Startup, @uts); // nanoseconds timestamp + coeff
  {$else}
  // try Linux kernel 2.6.32+ or FreeBSD 8.1+ fastest clocks
  tpfail := 0;
  if clock_gettime(CLOCK_REALTIME_COARSE, @tp[0]) = 0 then
    CLOCK_REALTIME_FAST := CLOCK_REALTIME_COARSE
  else if clock_gettime(CLOCK_REALTIME_FAST, @tp[0]) <> 0 then
    tpfail := 1;
  if clock_gettime(CLOCK_MONOTONIC_COARSE, @tp[1]) = 0 then
    CLOCK_MONOTONIC_FAST := CLOCK_MONOTONIC_COARSE
  else if clock_gettime(CLOCK_MONOTONIC_FAST,  @tp[1]) <> 0 then
    tpfail := tpfail or 2;
  {$ifdef OSLINUX}
  if clock_gettime(CLOCK_MONOTONIC_RAW, @tp[2]) = 0 then
    CLOCK_MONOTONIC_HIRES := CLOCK_MONOTONIC_RAW
  else if clock_gettime(CLOCK_MONOTONIC_HIRES, @tp[2]) <> 0 then
    tpfail := tpfail or 4;
  if clock_gettime(CLOCK_BOOTTIME, @tp[3]) = 0 then // 2.6.39+
    CLOCK_UPTIME := CLOCK_BOOTTIME
  else if clock_gettime(CLOCK_UPTIME, @tp[3]) <> 0 then
    tpfail := tpfail or 8;
  {$endif OSLINUX}
  crc32c128(@SystemEntropy.Startup, @tp, SizeOf(tp)); // tp[0..n] in nanoseconds
  // CpuCache, Executable.Hash, CpuFeatures will be added in main mormot.core.os
  if tpfail <> 0 then
    ConsoleErrorWrite(_fmt('clock_gettime(%d) failed on %s - errno=%d',
      [tpfail, OSVersionText, fpgeterrno])); // process is likely to fail anyway
  // direct access to the pthread library if possible (Linux only)
  {$ifdef OSPTHREADSLIB}
  // mutex_lock() is blocking when dlopen run from a .so: cthreads uses both
  // static and dynamic linking, which is really confusing to our code
  // -> we don't open libpthread but we get its symbol
  pthread := dlopen('libpthread.so.0', RTLD_LAZY);
  if pthread <> nil then
  begin
    {$ifdef HAS_PTHREADSETNAMENP}
    @pthread_setname_np := dlsym(pthread, 'pthread_setname_np');
    {$endif HAS_PTHREADSETNAMENP}
    {$ifdef HAS_PTHREADSETAFFINITY}
    @pthread_setaffinity_np := dlsym(pthread, 'pthread_setaffinity_np');
    {$endif HAS_PTHREADSETAFFINITY}
    @pthread_cancel := dlsym(pthread, 'pthread_cancel');
    @pthread_mutex_init := dlsym(pthread, 'pthread_mutex_init');
    @pthread_mutex_destroy := dlsym(pthread, 'pthread_mutex_destroy');
    @pthread_mutex_trylock := dlsym(pthread, 'pthread_mutex_trylock');
    @pthread_mutex_lock    := dlsym(pthread, 'pthread_mutex_lock');
    @pthread_mutex_unlock  := dlsym(pthread, 'pthread_mutex_unlock');
  end;
  {$endif OSPTHREADSLIB}
  {$ifdef CPUX64}
  {$ifdef OSLINUX}
  {$ifndef NOPATCHRTL}
  // redirect some syscall FPC RTL functions to faster vDSO libc variant
  {$ifndef FPC_USE_LIBC}
  RedirectCode(@Linux.clock_gettime, @clock_gettime_c);
  // will avoid syscall e.g. for events timeout in cthreads.pp
  RedirectCode(@fpgettimeofday, @gettimeofday_c);
  {$endif FPC_USE_LIBC}
  {$endif NOPATCHRTL}
  {$endif OSLINUX}
  {$endif CPUX64}
  {$endif OSDARWIN}
  {$ifdef OSLINUXANDROID}
  // add entropy from auxiliary vectors - https://lwn.net/Articles/519085/
  auxv := pointer(system.envp);
  while auxv^ <> 0 do
    inc(auxv);
  inc(auxv); // set by kernel's ELF binary loader after all env PPAnsiChar
  P := pointer(auxv);
  while auxv[0] <> 0 do
  begin
    if auxv[0] = 25 then // AT_RANDOM: 16 random bytes (used for stacks canary)
      with SystemEntropy do
      begin
        LiveFeed := PHash128Rec(auxv[1])^; // great initial source from Kernel
        XorMemory(Startup, PHash128Rec(auxv[1])^); // won't hurt
      end;
    auxv := @auxv[2];
  end;
  crc32c128(@SystemEntropy.Startup, P, PAnsiChar(auxv) - P); // all auxv info
  {$endif OSLINUXANDROID}
end;

procedure FinalizeSpecificUnit;
begin
  {$ifdef OSPTHREADSLIB}
  if pthread <> nil then
    dlclose(pthread);
  {$endif OSPTHREADSLIB}
  {$ifdef OSLINUX} // systemd API is Linux-specific
  sd.Done;
  {$endif OSLINUX}
  icu.Done;
  SynDaemonInterceptLog := nil;
end;


